Session Transitive_Models
Theory Nat_Miscellanea
sectionâ¹Auxiliary results on arithmeticâº
theory Nat_Miscellanea
imports
Delta_System_Lemma.ZF_Library
begin
notation add (infixl â¹+â©Ï⺠65)
notation diff (infixl â¹-â©Ï⺠65)
textâ¹Most of these results will get used at some point for the
calculation of arities.âº
lemmas nat_succI = Ord_succ_mem_iff [THEN iffD2,OF nat_into_Ord]
lemma nat_succD : "m â nat â¹ succ(n) â succ(m) â¹ n â m"
by (drule_tac j="succ(m)" in ltI,auto elim:ltD)
lemmas zero_in_succ = ltD [OF nat_0_le]
lemma in_n_in_nat : "m â nat â¹ n â m â¹ n â nat"
by(drule ltI[of "n"],auto simp add: lt_nat_in_nat)
lemma ltI_neg : "x â nat â¹ j ⤠x â¹ j â x â¹ j < x"
by (simp add: le_iff)
lemma succ_pred_eq : "m â nat â¹ m â 0 â¹ succ(pred(m)) = m"
by (auto elim: natE)
lemma succ_ltI : "succ(j) < n â¹ j < n"
by (simp add: succ_leE[OF leI])
lemmas succ_leD = succ_leE[OF leI]
lemma succpred_leI : "n â nat â¹ n ⤠succ(pred(n))"
by (auto elim: natE)
lemma succpred_n0 : "succ(n) â p â¹ pâ 0"
by (auto)
lemmas natEin = natE [OF lt_nat_in_nat]
lemmas Un_least_lt_iffn = Un_least_lt_iff [OF nat_into_Ord nat_into_Ord]
lemma pred_type : "m â nat â¹ n ⤠m â¹ nânat"
by (rule leE,auto simp:in_n_in_nat ltD)
lemma pred_le : "m â nat â¹ n ⤠succ(m) â¹ pred(n) ⤠m"
by(rule_tac n="n" in natE,auto simp add:pred_type[of "succ(m)"])
lemma pred_le2 : "nâ nat â¹ m â nat â¹ pred(n) ⤠m â¹ n ⤠succ(m)"
by(subgoal_tac "nânat",rule_tac n="n" in natE,auto)
lemma Un_leD1 : "Ord(i)⹠Ord(j)⹠Ord(k)⹠i ⪠j ⤠k ⹠i ⤠k"
by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all)
lemma Un_leD2 : "Ord(i)â¹ Ord(j)â¹ Ord(k)â¹ i ⪠j â¤k â¹ j ⤠k"
by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all)
lemma gt1 : "n â nat â¹ i â n â¹ i â 0 â¹ i â 1 â¹ 1<i"
by(rule_tac n="i" in natE,erule in_n_in_nat,auto intro: Ord_0_lt)
lemma pred_mono : "m â nat â¹ n ⤠m â¹ pred(n) ⤠pred(m)"
by(rule_tac n="n" in natE,auto simp add:le_in_nat,erule_tac n="m" in natE,auto)
lemma succ_mono : "m â nat â¹ n ⤠m â¹ succ(n) ⤠succ(m)"
by auto
lemma union_abs1 :
"⦠i ⤠j ⧠⹠i ⪠j = j"
by (rule Un_absorb1,erule le_imp_subset)
lemma union_abs2 :
"⦠i ⤠j ⧠⹠j ⪠i = j"
by (rule Un_absorb2,erule le_imp_subset)
lemma ord_un_max : "Ord(i) ⹠Ord(j) ⹠i ⪠j = max(i,j)"
using max_def union_abs1 not_lt_iff_le leI union_abs2
by auto
lemma ord_max_ty : "Ord(i) â¹Ord(j) â¹ Ord(max(i,j))"
unfolding max_def by simp
lemmas ord_simp_union = ord_un_max ord_max_ty max_def
lemma le_succ : "xânat â¹ xâ¤succ(x)" by simp
lemma le_pred : "xânat â¹ pred(x)â¤x"
using pred_le[OF _ le_succ] pred_succ_eq
by simp
lemma not_le_anti_sym : "xânat â¹ y â nat ⹠¬ xâ¤y ⹠¬yâ¤x â¹ y=x"
using Ord_linear not_le_iff_lt ltD lt_trans
by auto
lemma Un_le_compat : "o ⤠p ⹠q ⤠r ⹠Ord(o) ⹠Ord(p) ⹠Ord(q) ⹠Ord(r) ⹠o ⪠q ⤠p ⪠r"
using le_trans[of q r "pâªr",OF _ Un_upper2_le] le_trans[of o p "pâªr",OF _ Un_upper1_le]
ord_simp_union
by auto
lemma Un_le : "p ⤠r â¹ q ⤠r â¹
Ord(p) â¹ Ord(q) â¹ Ord(r) â¹
p ⪠q ⤠r"
using ord_simp_union by auto
lemma Un_leI3 : "o ⤠r â¹ p ⤠r â¹ q ⤠r â¹
Ord(o) â¹ Ord(p) â¹ Ord(q) â¹ Ord(r) â¹
o ⪠p ⪠q ⤠r"
using ord_simp_union by auto
lemma diff_mono :
assumes "m â nat" "nânat" "p â nat" "m < n" "pâ¤m"
shows "m#-p < n#-p"
proof -
from assms
have "m#-p â nat" "m#-p +â©Ïp = m"
using add_diff_inverse2 by simp_all
with assms
show ?thesis
using less_diff_conv[of n p "m #- p",THEN iffD2] by simp
qed
lemma pred_Un:
"x â nat â¹ y â nat â¹ pred(succ(x) ⪠y) = x ⪠pred(y)"
"x â nat â¹ y â nat â¹ pred(x ⪠succ(y)) = pred(x) ⪠y"
using pred_Un_distrib pred_succ_eq by simp_all
lemma le_natI : "j ⤠n â¹ n â nat â¹ jânat"
by(drule ltD,rule in_n_in_nat,rule nat_succ_iff[THEN iffD2,of n],simp_all)
lemma le_natE : "nânat â¹ j < n â¹ jân"
by(rule ltE[of j n],simp+)
lemma leD : assumes "nânat" "j ⤠n"
shows "j < n | j = n"
using leE[OF â¹jâ¤nâº,of "j<n | j = n"] by auto
lemma pred_nat_eq :
assumes "nânat"
shows "pred(n) = â n"
using assms
proof(induct)
case 0
then show ?case by simp
next
case (succ x)
then show ?case using pred_succ_eq Ord_Union_succ_eq
by simp
qed
subsectionâ¹Some results in ordinal arithmeticâº
textâ¹The following results are auxiliary to the proof of
wellfoundedness of the relation \<^term>â¹frecRâºâº
lemma max_cong :
assumes "x ⤠y" "Ord(y)" "Ord(z)"
shows "max(x,y) ⤠max(y,z)"
proof (cases "y ⤠z")
case True
then show ?thesis
unfolding max_def using assms by simp
next
case False
then have "z ⤠y" using assms not_le_iff_lt leI by simp
then show ?thesis
unfolding max_def using assms by simp
qed
lemma max_commutes :
assumes "Ord(x)" "Ord(y)"
shows "max(x,y) = max(y,x)"
using assms Un_commute ord_simp_union(1) ord_simp_union(1)[symmetric] by auto
lemma max_cong2 :
assumes "x ⤠y" "Ord(y)" "Ord(z)" "Ord(x)"
shows "max(x,z) ⤠max(y,z)"
proof -
from assms
have " x ⪠z ⤠y ⪠z"
using lt_Ord Ord_Un Un_mono[OF le_imp_subset[OF â¹xâ¤yâº]] subset_imp_le by auto
then show ?thesis
using ord_simp_union â¹Ord(x)⺠â¹Ord(z)⺠â¹Ord(y)⺠by simp
qed
lemma max_D1 :
assumes "x = y" "w < z" "Ord(x)" "Ord(w)" "Ord(z)" "max(x,w) = max(y,z)"
shows "zâ¤y"
proof -
from assms
have "w < x ⪠w" using Un_upper2_lt[OF â¹w<zâº] assms ord_simp_union by simp
then
have "w < x" using assms lt_Un_iff[of x w w] lt_not_refl by auto
then
have "y = y ⪠z" using assms max_commutes ord_simp_union assms leI by simp
then
show ?thesis using Un_leD2 assms by simp
qed
lemma max_D2 :
assumes "w = y ⨠w = z" "x < y" "Ord(x)" "Ord(w)" "Ord(y)" "Ord(z)" "max(x,w) = max(y,z)"
shows "x<w"
proof -
from assms
have "x < z ⪠y" using Un_upper2_lt[OF â¹x<yâº] by simp
then
consider (a) "x < y" | (b) "x < w"
using assms ord_simp_union by simp
then show ?thesis proof (cases)
case a
consider (c) "w = y" | (d) "w = z"
using assms by auto
then show ?thesis proof (cases)
case c
with a show ?thesis by simp
next
case d
with a
show ?thesis
proof (cases "y <w")
case True
then show ?thesis using lt_trans[OF â¹x<yâº] by simp
next
case False
then
have "w ⤠y"
using not_lt_iff_le[OF assms(5) assms(4)] by simp
with â¹w=zâº
have "max(z,y) = y" unfolding max_def using assms by simp
with assms
have "... = x ⪠w" using ord_simp_union max_commutes by simp
then show ?thesis using le_Un_iff assms by blast
qed
qed
next
case b
then show ?thesis .
qed
qed
lemma oadd_lt_mono2 :
assumes "Ord(n)" "Ord(α)" "Ord(β)" "α < β" "x < n" "y < n" "0 <n"
shows "n ** α + x < n **β + y"
proof -
consider (0) "β=0" | (s) γ where "Ord(γ)" "β = succ(γ)" | (l) "Limit(β)"
using Ord_cases[OF â¹Ord(β)âº,of ?thesis] by force
then show ?thesis
proof cases
case 0
then show ?thesis using â¹Î±<β⺠by auto
next
case s
then
have "αâ¤Î³" using â¹Î±<β⺠using leI by auto
then
have "n ** α ⤠n ** γ" using omult_le_mono[OF _ â¹Î±â¤Î³âº] â¹Ord(n)⺠by simp
then
have "n ** α + x < n ** γ + n" using oadd_lt_mono[OF _ â¹x<nâº] by simp
also
have "... = n ** β" using â¹Î²=succ(_)⺠omult_succ â¹Ord(β)⺠â¹Ord(n)⺠by simp
finally
have "n ** α + x < n ** β" by auto
then
show ?thesis using oadd_le_self â¹Ord(β)⺠lt_trans2 â¹Ord(n)⺠by auto
next
case l
have "Ord(x)" using â¹x<n⺠lt_Ord by simp
with l
have "succ(α) < β" using Limit_has_succ â¹Î±<β⺠by simp
have "n ** α + x < n ** α + n"
using oadd_lt_mono[OF le_refl[OF Ord_omult[OF _ â¹Ord(α)âº]] â¹x<nâº] â¹Ord(n)⺠by simp
also
have "... = n ** succ(α)" using omult_succ â¹Ord(α)⺠â¹Ord(n)⺠by simp
finally
have "n ** α + x < n ** succ(α)" by simp
with â¹succ(α) < βâº
have "n ** α + x < n ** β" using lt_trans omult_lt_mono â¹Ord(n)⺠â¹0<n⺠by auto
then show ?thesis using oadd_le_self â¹Ord(β)⺠lt_trans2 â¹Ord(n)⺠by auto
qed
qed
end
body>
Theory ZF_Miscellanea
sectionâ¹Various results missing from ZF.âº
theory ZF_Miscellanea
imports
ZF
Nat_Miscellanea
begin
lemma function_subset:
"function(f) â¹ gâf â¹ function(g)"
unfolding function_def subset_def by auto
lemma converse_refl : "refl(A,r) â¹ refl(A,converse(r))"
unfolding refl_def by simp
lemma Ord_lt_subset : "Ord(b) â¹ a<b â¹ aâb"
by(intro subsetI,frule ltD,rule_tac Ord_trans,simp_all)
lemma funcI : "f â A â B â¹ a â A â¹ b= f ` a â¹ â¨a, bâ© â f"
by(simp_all add: apply_Pair)
lemma vimage_fun_sing:
assumes "fâAâB" "bâB"
shows "{aâA . f`a=b} = f-``{b}"
using assms vimage_singleton_iff function_apply_equality Pi_iff funcI by auto
lemma image_fun_subset: "SâAâB â¹ CâAâ¹ {S ` x . xâ C} = S``C"
using image_function[symmetric,of S C] domain_of_fun Pi_iff by auto
lemma subset_Diff_Un: "X â A â¹ A = (A - X) ⪠X " by auto
lemma Diff_bij:
assumes "âAâF. X â A" shows "(λAâF. A-X) â bij(F, {A-X. AâF})"
using assms unfolding bij_def inj_def surj_def
by (auto intro:lam_type, subst subset_Diff_Un[of X]) auto
lemma function_space_nonempty:
assumes "bâB"
shows "(λxâA. b) : A â B"
using assms lam_type by force
lemma vimage_lam: "(λxâA. f(x)) -`` B = { xâA . f(x) â B }"
using lam_funtype[of A f, THEN [2] domain_type]
lam_funtype[of A f, THEN [2] apply_equality] lamI[of _ A f]
by auto blast
lemma range_fun_subset_codomain:
assumes "h:B â C"
shows "range(h) â C"
unfolding range_def domain_def converse_def using range_type[OF _ assms] by auto
lemma Pi_rangeD:
assumes "fâPi(A,B)" "b â range(f)"
shows "âaâA. f`a = b"
using assms apply_equality[OF _ assms(1), of _ b]
domain_type[OF _ assms(1)] by auto
lemma Pi_range_eq: "f â Pi(A,B) â¹ range(f) = {f ` x . x â A}"
using Pi_rangeD[of f A B] apply_rangeI[of f A B]
by blast
lemma Pi_vimage_subset : "f â Pi(A,B) â¹ f-``C â A"
unfolding Pi_def by auto
definition
minimum :: "i â i â i" where
"minimum(r,B) â¡ THE b. first(b,B,r)"
lemma minimum_in: "⦠well_ord(A,r); BâA; Bâ 0 ⧠⹠minimum(r,B) â B"
using the_first_in unfolding minimum_def by simp
lemma well_ord_surj_imp_inj_inverse:
assumes "well_ord(A,r)" "h â surj(A,B)"
shows "(λbâB. minimum(r, {aâA. h`a=b})) â inj(B,A)"
proof -
let ?f="λbâB. minimum(r, {aâA. h`a=b})"
have "minimum(r, {a â A . h ` a = b}) â {aâA. h`a=b}" if "bâB" for b
proof -
from â¹h â surj(A,B)⺠that
have "{aâA. h`a=b} â 0"
unfolding surj_def by blast
with â¹well_ord(A,r)âº
show "minimum(r,{aâA. h`a=b}) â {aâA. h`a=b}"
using minimum_in by blast
qed
moreover from this
have "?f : B â A"
using lam_type[of B _ "λ_.A"] by simp
moreover
have "?f ` w = ?f ` x â¹ w = x" if "wâB" "xâB" for w x
proof -
from calculation that
have "w = h ` minimum(r,{aâA. h`a=w})"
"x = h ` minimum(r,{aâA. h`a=x})"
by simp_all
moreover
assume "?f ` w = ?f ` x"
moreover from this and that
have "minimum(r, {a â A . h ` a = w}) = minimum(r, {a â A . h ` a = x})"
unfolding minimum_def by simp_all
moreover from calculation(1,2,4)
show "w=x" by simp
qed
ultimately
show ?thesis
unfolding inj_def by blast
qed
lemma well_ord_surj_imp_lepoll:
assumes "well_ord(A,r)" "h â surj(A,B)"
shows "Bâ²A"
unfolding lepoll_def using well_ord_surj_imp_inj_inverse[OF assms]
by blast
lemma surj_imp_well_ord:
assumes "well_ord(A,r)" "h â surj(A,B)"
shows "âs. well_ord(B,s)"
using assms lepoll_well_ord[OF well_ord_surj_imp_lepoll]
by force
lemma Pow_sing : "Pow({a}) = {0,{a}}"
proof(intro equalityI,simp_all)
have "z â {0,{a}}" if "z â {a}" for z
using that by auto
then
show " Pow({a}) â {0, {a}}" by auto
qed
lemma Pow_cons:
shows "Pow(cons(a,A)) = Pow(A) ⪠{{a} ⪠X . X: Pow(A)}"
using Un_Pow_subset Pow_sing
proof(intro equalityI,auto simp add:Un_Pow_subset)
{
fix C D
assume "â B . BâPow(A) â¹ C â {a} ⪠B" "C â {a} ⪠A" "D â C"
moreover from this
have "âxâC . x=a ⨠xâA" by auto
moreover from calculation
consider (a) "D=a" | (b) "DâA" by auto
from this
have "DâA"
proof(cases)
case a
with calculation show ?thesis by auto
next
case b
then show ?thesis by simp
qed
}
then show "âx xa. (âxaâPow(A). x â {a} ⪠xa) â¹ x â cons(a, A) â¹ xa â x â¹ xa â A"
by auto
qed
lemma app_nm :
assumes "nânat" "mânat" "fânâm" "x â nat"
shows "f`x â nat"
proof(cases "xân")
case True
then show ?thesis using assms in_n_in_nat apply_type by simp
next
case False
then show ?thesis using assms apply_0 domain_of_fun by simp
qed
lemma Upair_eq_cons: "Upair(a,b) = {a,b}"
unfolding cons_def by auto
lemma converse_apply_eq : "converse(f) ` x = â(f -`` {x})"
unfolding apply_def vimage_def by simp
lemmas app_fun = apply_iff[THEN iffD1]
lemma Finite_imp_lesspoll_nat:
assumes "Finite(A)"
shows "A ⺠nat"
using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
n_lesspoll_nat eq_lesspoll_trans
unfolding Finite_def lesspoll_def by auto
end
Theory Renaming
sectionâ¹Renaming of variables in internalized formulasâº
theory Renaming
imports
ZF_Miscellanea
"ZF-Constructible.Formula"
begin
subsectionâ¹Renaming of free variablesâº
definition
union_fun :: "[i,i,i,i] â i" where
"union_fun(f,g,m,p) ⡠λj â m ⪠p . if jâm then f`j else g`j"
lemma union_fun_type:
assumes "f â m â n"
"g â p â q"
shows "union_fun(f,g,m,p) â m ⪠p â n ⪠q"
proof -
let ?h="union_fun(f,g,m,p)"
have
D: "?h`x â n ⪠q" if "x â m ⪠p" for x
proof (cases "x â m")
case True
then have
"x â m ⪠p" by simp
with â¹xâmâº
have "?h`x = f`x"
unfolding union_fun_def beta by simp
with â¹f â m â n⺠â¹xâmâº
have "?h`x â n" by simp
then show ?thesis ..
next
case False
with â¹x â m ⪠pâº
have "x â p"
by auto
with â¹xâmâº
have "?h`x = g`x"
unfolding union_fun_def using beta by simp
with â¹g â p â q⺠â¹xâpâº
have "?h`x â q" by simp
then show ?thesis ..
qed
have A:"function(?h)" unfolding union_fun_def using function_lam by simp
have " xâ (m ⪠p) à (n ⪠q)" if "xâ ?h" for x
using that lamE[of x "m ⪠p" _ "x â (m ⪠p) à (n ⪠q)"] D unfolding union_fun_def
by auto
then have B:"?h â (m ⪠p) à (n ⪠q)" ..
have "m ⪠p â domain(?h)"
unfolding union_fun_def using domain_lam by simp
with A B
show ?thesis using Pi_iff [THEN iffD2] by simp
qed
lemma union_fun_action :
assumes
"env â list(M)"
"env' â list(M)"
"length(env) = m ⪠p"
"â i . i â m ⶠnth(f`i,env') = nth(i,env)"
"â j . j â p ⶠnth(g`j,env') = nth(j,env)"
shows "â i . i â m ⪠p â¶
nth(i,env) = nth(union_fun(f,g,m,p)`i,env')"
proof -
let ?h = "union_fun(f,g,m,p)"
have "nth(x, env) = nth(?h`x,env')" if "x â m ⪠p" for x
using that
proof (cases "xâm")
case True
with â¹xâmâº
have "?h`x = f`x"
unfolding union_fun_def beta by simp
with assms â¹xâmâº
have "nth(x,env) = nth(?h`x,env')" by simp
then show ?thesis .
next
case False
with â¹x â m ⪠pâº
have
"x â p" "xâm" by auto
then
have "?h`x = g`x"
unfolding union_fun_def beta by simp
with assms â¹xâpâº
have "nth(x,env) = nth(?h`x,env')" by simp
then show ?thesis .
qed
then show ?thesis by simp
qed
lemma id_fn_type :
assumes "n â nat"
shows "id(n) â n â n"
unfolding id_def using â¹nânat⺠by simp
lemma id_fn_action:
assumes "n â nat" "envâlist(M)"
shows "â j . j < n â¹ nth(j,env) = nth(id(n)`j,env)"
proof -
show "nth(j,env) = nth(id(n)`j,env)" if "j < n" for j using that â¹nânat⺠ltD by simp
qed
definition
rsum :: "[i,i,i,i,i] â i" where
"rsum(f,g,m,n,p) ⡠λj â m+â©Ïp . if j<m then f`j else (g`(j#-m))+â©Ïn"
lemma sum_inl:
assumes "m â nat" "nânat"
"f â mân" "x â m"
shows "rsum(f,g,m,n,p)`x = f`x"
proof -
from â¹mânatâº
have "mâ¤m+â©Ïp"
using add_le_self[of m] by simp
with assms
have "xâm+â©Ïp"
using ltI[of x m] lt_trans2[of x m "m+â©Ïp"] ltD by simp
from assms
have "x<m"
using ltI by simp
with â¹xâm+â©Ïpâº
show ?thesis unfolding rsum_def by simp
qed
lemma sum_inr:
assumes "m â nat" "nânat" "pânat"
"gâpâq" "m ⤠x" "x < m+â©Ïp"
shows "rsum(f,g,m,n,p)`x = g`(x#-m)+â©Ïn"
proof -
from assms
have "xânat"
using in_n_in_nat[of "m+â©Ïp"] ltD
by simp
with assms
have "¬ x<m"
using not_lt_iff_le[THEN iffD2] by simp
from assms
have "xâm+â©Ïp"
using ltD by simp
with â¹Â¬ x<mâº
show ?thesis unfolding rsum_def by simp
qed
lemma sum_action :
assumes "m â nat" "nânat" "pânat" "qânat"
"f â mân" "gâpâq"
"env â list(M)"
"env' â list(M)"
"env1 â list(M)"
"env2 â list(M)"
"length(env) = m"
"length(env1) = p"
"length(env') = n"
"â i . i < m â¹ nth(i,env) = nth(f`i,env')"
"â j. j < p â¹ nth(j,env1) = nth(g`j,env2)"
shows "â i . i < m+â©Ïp â¶
nth(i,env@env1) = nth(rsum(f,g,m,n,p)`i,env'@env2)"
proof -
let ?h = "rsum(f,g,m,n,p)"
from â¹mânat⺠â¹nânat⺠â¹qânatâº
have "mâ¤m+â©Ïp" "nâ¤n+â©Ïq" "qâ¤n+â©Ïq"
using add_le_self[of m] add_le_self2[of n q] by simp_all
from â¹pânatâº
have "p = (m+â©Ïp)#-m" using diff_add_inverse2 by simp
have "nth(x, env @ env1) = nth(?h`x,env'@env2)" if "x<m+â©Ïp" for x
proof (cases "x<m")
case True
then
have 2: "?h`x= f`x" "xâm" "f`x â n" "xânat"
using assms sum_inl ltD apply_type[of f m _ x] in_n_in_nat by simp_all
with â¹x<m⺠assms
have "f`x < n" "f`x<length(env')" "f`xânat"
using ltI in_n_in_nat by simp_all
with 2 â¹x<m⺠assms
have "nth(x,env@env1) = nth(x,env)"
using nth_append[OF â¹envâlist(M)âº] â¹xânat⺠by simp
also
have
"... = nth(f`x,env')"
using 2 â¹x<m⺠assms by simp
also
have "... = nth(f`x,env'@env2)"
using nth_append[OF â¹env'âlist(M)âº] â¹f`x<length(env')⺠â¹f`x ânat⺠by simp
also
have "... = nth(?h`x,env'@env2)"
using 2 by simp
finally
have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
then show ?thesis .
next
case False
have "xânat"
using that in_n_in_nat[of "m+â©Ïp" x] ltD â¹pânat⺠â¹mânat⺠by simp
with â¹length(env) = mâº
have "mâ¤x" "length(env) ⤠x"
using not_lt_iff_le â¹mânat⺠â¹Â¬x<m⺠by simp_all
with â¹Â¬x<m⺠â¹length(env) = mâº
have 2 : "?h`x= g`(x#-m)+â©Ïn" "¬ x <length(env)"
unfolding rsum_def
using sum_inr that beta ltD by simp_all
from assms â¹xânat⺠â¹p=m+â©Ïp#-mâº
have "x#-m < p"
using diff_mono[OF _ _ _ â¹x<m+â©Ïp⺠â¹mâ¤xâº] by simp
then have "x#-mâp" using ltD by simp
with â¹gâpâqâº
have "g`(x#-m) â q" by simp
with â¹qânat⺠â¹length(env') = nâº
have "g`(x#-m) < q" "g`(x#-m)ânat" using ltI in_n_in_nat by simp_all
with â¹qânat⺠â¹nânatâº
have "(g`(x#-m))+â©Ïn <n+â©Ïq" "n ⤠g`(x#-m)+â©Ïn" "¬ g`(x#-m)+â©Ïn < length(env')"
using add_lt_mono1[of "g`(x#-m)" _ n,OF _ â¹qânatâº]
add_le_self2[of n] â¹length(env') = nâº
by simp_all
from assms â¹Â¬ x < length(env)⺠â¹length(env) = mâº
have "nth(x,env @ env1) = nth(x#-m,env1)"
using nth_append[OF â¹envâlist(M)⺠â¹xânatâº] by simp
also
have "... = nth(g`(x#-m),env2)"
using assms â¹x#-m < p⺠by simp
also
have "... = nth((g`(x#-m)+â©Ïn)#-length(env'),env2)"
using â¹length(env') = nâº
diff_add_inverse2 â¹g`(x#-m)ânatâº
by simp
also
have "... = nth((g`(x#-m)+â©Ïn),env'@env2)"
using nth_append[OF â¹env'âlist(M)âº] â¹nânat⺠â¹Â¬ g`(x#-m)+â©Ïn < length(env')âº
by simp
also
have "... = nth(?h`x,env'@env2)"
using 2 by simp
finally
have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
then show ?thesis .
qed
then show ?thesis by simp
qed
lemma sum_type :
assumes "m â nat" "nânat" "pânat" "qânat"
"f â mân" "gâpâq"
shows "rsum(f,g,m,n,p) â (m+â©Ïp) â (n+â©Ïq)"
proof -
let ?h = "rsum(f,g,m,n,p)"
from â¹mânat⺠â¹nânat⺠â¹qânatâº
have "mâ¤m+â©Ïp" "nâ¤n+â©Ïq" "qâ¤n+â©Ïq"
using add_le_self[of m] add_le_self2[of n q] by simp_all
from â¹pânatâº
have "p = (m+â©Ïp)#-m" using diff_add_inverse2 by simp
{fix x
assume 1: "xâm+â©Ïp" "x<m"
with 1 have "?h`x= f`x" "xâm"
using assms sum_inl ltD by simp_all
with â¹fâmânâº
have "?h`x â n" by simp
with â¹nânat⺠have "?h`x < n" using ltI by simp
with â¹nâ¤n+â©Ïqâº
have "?h`x < n+â©Ïq" using lt_trans2 by simp
then
have "?h`x â n+â©Ïq" using ltD by simp
}
then have 1:"?h`x â n+â©Ïq" if "xâm+â©Ïp" "x<m" for x using that .
{fix x
assume 1: "xâm+â©Ïp" "mâ¤x"
then have "x<m+â©Ïp" "xânat" using ltI in_n_in_nat[of "m+â©Ïp"] ltD by simp_all
with 1
have 2 : "?h`x= g`(x#-m)+â©Ïn"
using assms sum_inr ltD by simp_all
from assms â¹xânat⺠â¹p=m+â©Ïp#-mâº
have "x#-m < p" using diff_mono[OF _ _ _ â¹x<m+â©Ïp⺠â¹mâ¤xâº] by simp
then have "x#-mâp" using ltD by simp
with â¹gâpâqâº
have "g`(x#-m) â q" by simp
with â¹qânat⺠have "g`(x#-m) < q" using ltI by simp
with â¹qânatâº
have "(g`(x#-m))+â©Ïn <n+â©Ïq" using add_lt_mono1[of "g`(x#-m)" _ n,OF _ â¹qânatâº] by simp
with 2
have "?h`x â n+â©Ïq" using ltD by simp
}
then have 2:"?h`x â n+â©Ïq" if "xâm+â©Ïp" "mâ¤x" for x using that .
have
D: "?h`x â n+â©Ïq" if "xâm+â©Ïp" for x
using that
proof (cases "x<m")
case True
then show ?thesis using 1 that by simp
next
case False
with â¹mânat⺠have "mâ¤x" using not_lt_iff_le that in_n_in_nat[of "m+â©Ïp"] by simp
then show ?thesis using 2 that by simp
qed
have A:"function(?h)" unfolding rsum_def using function_lam by simp
have " xâ (m +â©Ï p) Ã (n +â©Ï q)" if "xâ ?h" for x
using that lamE[of x "m+â©Ïp" _ "x â (m +â©Ï p) Ã (n +â©Ï q)"] D unfolding rsum_def
by auto
then have B:"?h â (m +â©Ï p) Ã (n +â©Ï q)" ..
have "m +â©Ï p â domain(?h)"
unfolding rsum_def using domain_lam by simp
with A B
show ?thesis using Pi_iff [THEN iffD2] by simp
qed
lemma sum_type_id :
assumes
"f â length(env)âlength(env')"
"env â list(M)"
"env' â list(M)"
"env1 â list(M)"
shows
"rsum(f,id(length(env1)),length(env),length(env'),length(env1)) â
(length(env)+â©Ïlength(env1)) â (length(env')+â©Ïlength(env1))"
using assms length_type id_fn_type sum_type
by simp
lemma sum_type_id_aux2 :
assumes
"f â mân"
"m â nat" "n â nat"
"env1 â list(M)"
shows
"rsum(f,id(length(env1)),m,n,length(env1)) â
(m+â©Ïlength(env1)) â (n+â©Ïlength(env1))"
using assms id_fn_type sum_type
by auto
lemma sum_action_id :
assumes
"env â list(M)"
"env' â list(M)"
"f â length(env)âlength(env')"
"env1 â list(M)"
"â i . i < length(env) â¹ nth(i,env) = nth(f`i,env')"
shows "â i . i < length(env)+â©Ïlength(env1) â¹
nth(i,env@env1) = nth(rsum(f,id(length(env1)),length(env),length(env'),length(env1))`i,env'@env1)"
proof -
from assms
have "length(env)ânat" (is "?m â _") by simp
from assms have "length(env')ânat" (is "?n â _") by simp
from assms have "length(env1)ânat" (is "?p â _") by simp
note lenv = id_fn_action[OF â¹?pânat⺠â¹env1âlist(M)âº]
note lenv_ty = id_fn_type[OF â¹?pânatâº]
{
fix i
assume "i < length(env)+â©Ïlength(env1)"
have "nth(i,env@env1) = nth(rsum(f,id(length(env1)),?m,?n,?p)`i,env'@env1)"
using sum_action[OF â¹?mânat⺠â¹?nânat⺠â¹?pânat⺠â¹?pânat⺠â¹fâ?mâ?nâº
lenv_ty â¹envâlist(M)⺠â¹env'âlist(M)âº
â¹env1âlist(M)⺠â¹env1âlist(M)⺠_
_ _ assms(5) lenv
] â¹i<?m+â©Ïlength(env1)⺠by simp
}
then show "â i . i < ?m+â©Ïlength(env1) â¹
nth(i,env@env1) = nth(rsum(f,id(?p),?m,?n,?p)`i,env'@env1)" by simp
qed
lemma sum_action_id_aux :
assumes
"f â mân"
"env â list(M)"
"env' â list(M)"
"env1 â list(M)"
"length(env) = m"
"length(env') = n"
"length(env1) = p"
"â i . i < m â¹ nth(i,env) = nth(f`i,env')"
shows "â i . i < m+â©Ïlength(env1) â¹
nth(i,env@env1) = nth(rsum(f,id(length(env1)),m,n,length(env1))`i,env'@env1)"
using assms length_type id_fn_type sum_action_id
by auto
definition
sum_id :: "[i,i] â i" where
"sum_id(m,f) â¡ rsum(λxâ1.x,f,1,1,m)"
lemma sum_id0 : "mânatâ¹sum_id(m,f)`0 = 0"
by(unfold sum_id_def,subst sum_inl,auto)
lemma sum_idS : "pânat â¹ qânat â¹ fâpâq â¹ x â p â¹ sum_id(p,f)`(succ(x)) = succ(f`x)"
by(subgoal_tac "xânat",unfold sum_id_def,subst sum_inr,
simp_all add:ltI,simp_all add: app_nm in_n_in_nat)
lemma sum_id_tc_aux :
"p â nat â¹ q â nat â¹ f â p â q â¹ sum_id(p,f) â 1+â©Ïp â 1+â©Ïq"
by (unfold sum_id_def,rule sum_type,simp_all)
lemma sum_id_tc :
"n â nat â¹ m â nat â¹ f â n â m â¹ sum_id(n,f) â succ(n) â succ(m)"
by(rule ssubst[of "succ(n) â succ(m)" "1+â©Ïn â 1+â©Ïm"],
simp,rule sum_id_tc_aux,simp_all)
subsectionâ¹Renaming of formulasâº
consts ren :: "iâi"
primrec
"ren(Member(x,y)) =
(λ n â nat . λ m â nat. λf â n â m. Member (f`x, f`y))"
"ren(Equal(x,y)) =
(λ n â nat . λ m â nat. λf â n â m. Equal (f`x, f`y))"
"ren(Nand(p,q)) =
(λ n â nat . λ m â nat. λf â n â m. Nand (ren(p)`n`m`f, ren(q)`n`m`f))"
"ren(Forall(p)) =
(λ n â nat . λ m â nat. λf â n â m. Forall (ren(p)`succ(n)`succ(m)`sum_id(n,f)))"
lemma arity_meml : "l â nat â¹ Member(x,y) â formula â¹ arity(Member(x,y)) ⤠l â¹ x â l"
by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
lemma arity_memr : "l â nat â¹ Member(x,y) â formula â¹ arity(Member(x,y)) ⤠l â¹ y â l"
by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
lemma arity_eql : "l â nat â¹ Equal(x,y) â formula â¹ arity(Equal(x,y)) ⤠l â¹ x â l"
by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
lemma arity_eqr : "l â nat â¹ Equal(x,y) â formula â¹ arity(Equal(x,y)) ⤠l â¹ y â l"
by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
lemma nand_ar1 : "p â formula â¹ qâformula â¹arity(p) ⤠arity(Nand(p,q))"
by (simp,rule Un_upper1_le,simp+)
lemma nand_ar2 : "p â formula â¹ qâformula â¹arity(q) ⤠arity(Nand(p,q))"
by (simp,rule Un_upper2_le,simp+)
lemma nand_ar1D : "p â formula â¹ qâformula â¹ arity(Nand(p,q)) ⤠n â¹ arity(p) ⤠n"
by(auto simp add: le_trans[OF Un_upper1_le[of "arity(p)" "arity(q)"]])
lemma nand_ar2D : "p â formula â¹ qâformula â¹ arity(Nand(p,q)) ⤠n â¹ arity(q) ⤠n"
by(auto simp add: le_trans[OF Un_upper2_le[of "arity(p)" "arity(q)"]])
lemma ren_tc : "p â formula â¹
(â n m f . n â nat â¹ m â nat â¹ f â nâm â¹ ren(p)`n`m`f â formula)"
by (induct set:formula,auto simp add: app_nm sum_id_tc)
lemma arity_ren :
fixes "p"
assumes "p â formula"
shows "â n m f . n â nat â¹ m â nat â¹ f â nâm â¹ arity(p) ⤠n â¹ arity(ren(p)`n`m`f)â¤m"
using assms
proof (induct set:formula)
case (Member x y)
then have "f`x â m" "f`y â m"
using Member assms by (simp add: arity_meml apply_funtype,simp add:arity_memr apply_funtype)
then show ?case using Member by (simp add: Un_least_lt ltI)
next
case (Equal x y)
then have "f`x â m" "f`y â m"
using Equal assms by (simp add: arity_eql apply_funtype,simp add:arity_eqr apply_funtype)
then show ?case using Equal by (simp add: Un_least_lt ltI)
next
case (Nand p q)
then have "arity(p)â¤arity(Nand(p,q))"
"arity(q)â¤arity(Nand(p,q))"
by (subst nand_ar1,simp,simp,simp,subst nand_ar2,simp+)
then have "arity(p)â¤n"
and "arity(q)â¤n" using Nand
by (rule_tac j="arity(Nand(p,q))" in le_trans,simp,simp)+
then have "arity(ren(p)`n`m`f) ⤠m" and "arity(ren(q)`n`m`f) ⤠m"
using Nand by auto
then show ?case using Nand by (simp add:Un_least_lt)
next
case (Forall p)
from Forall have "succ(n)ânat" "succ(m)ânat" by auto
from Forall have 2: "sum_id(n,f) â succ(n)âsucc(m)" by (simp add:sum_id_tc)
from Forall have 3:"arity(p) ⤠succ(n)" by (rule_tac n="arity(p)" in natE,simp+)
then have "arity(ren(p)`succ(n)`succ(m)`sum_id(n,f))â¤succ(m)" using
Forall â¹succ(n)ânat⺠â¹succ(m)ânat⺠2 by force
then show ?case using Forall 2 3 ren_tc arity_type pred_le by auto
qed
lemma arity_forallE : "p â formula â¹ m â nat â¹ arity(Forall(p)) ⤠m â¹ arity(p) ⤠succ(m)"
by(rule_tac n="arity(p)" in natE,erule arity_type,simp+)
lemma env_coincidence_sum_id :
assumes "m â nat" "n â nat"
"Ï â list(A)" "Ï' â list(A)"
"f â n â m"
"â i . i < n â¹ nth(i,Ï) = nth(f`i,Ï')"
"a â A" "j â succ(n)"
shows "nth(j,Cons(a,Ï)) = nth(sum_id(n,f)`j,Cons(a,Ï'))"
proof -
let ?g="sum_id(n,f)"
have "succ(n) â nat" using â¹nânat⺠by simp
then have "j â nat" using â¹jâsucc(n)⺠in_n_in_nat by blast
then have "nth(j,Cons(a,Ï)) = nth(?g`j,Cons(a,Ï'))"
proof (cases rule:natE[OF â¹jânatâº])
case 1
then show ?thesis using assms sum_id0 by simp
next
case (2 i)
with â¹jâsucc(n)⺠have "succ(i)âsucc(n)" by simp
with â¹nânat⺠have "i â n" using nat_succD assms by simp
have "f`iâm" using â¹fânâm⺠apply_type â¹iân⺠by simp
then have "f`i â nat" using in_n_in_nat â¹mânat⺠by simp
have "nth(succ(i),Cons(a,Ï)) = nth(i,Ï)" using â¹iânat⺠by simp
also have "... = nth(f`i,Ï')" using assms â¹iân⺠ltI by simp
also have "... = nth(succ(f`i),Cons(a,Ï'))" using â¹f`iânat⺠by simp
also have "... = nth(?g`succ(i),Cons(a,Ï'))"
using assms sum_idS[OF â¹nânat⺠â¹mânat⺠â¹fânâm⺠â¹i â nâº] cases by simp
finally have "nth(succ(i),Cons(a,Ï)) = nth(?g`succ(i),Cons(a,Ï'))" .
then show ?thesis using â¹j=succ(i)⺠by simp
qed
then show ?thesis .
qed
lemma sats_iff_sats_ren :
assumes "Ï â formula"
shows "⦠n â nat ; m â nat ; Ï â list(M) ; Ï' â list(M) ; f â n â m ;
arity(Ï) ⤠n ;
â i . i < n â¹ nth(i,Ï) = nth(f`i,Ï') ⧠â¹
sats(M,Ï,Ï) â· sats(M,ren(Ï)`n`m`f,Ï')"
using â¹Ï â formulaâº
proof(induct Ï arbitrary:n m Ï Ï' f)
case (Member x y)
have "ren(Member(x,y))`n`m`f = Member(f`x,f`y)" using Member assms arity_type by force
moreover
have "x â n" using Member arity_meml by simp
moreover
have "y â n" using Member arity_memr by simp
ultimately
show ?case using Member ltI by simp
next
case (Equal x y)
have "ren(Equal(x,y))`n`m`f = Equal(f`x,f`y)" using Equal assms arity_type by force
moreover
have "x â n" using Equal arity_eql by simp
moreover
have "y â n" using Equal arity_eqr by simp
ultimately show ?case using Equal ltI by simp
next
case (Nand p q)
have "ren(Nand(p,q))`n`m`f = Nand(ren(p)`n`m`f,ren(q)`n`m`f)" using Nand by simp
moreover
have "arity(p) ⤠n" using Nand nand_ar1D by simp
moreover from this
have "i â arity(p) â¹ i â n" for i using subsetD[OF le_imp_subset[OF â¹arity(p) ⤠nâº]] by simp
moreover from this
have "i â arity(p) â¹ nth(i,Ï) = nth(f`i,Ï')" for i using Nand ltI by simp
moreover from this
have "sats(M,p,Ï) â· sats(M,ren(p)`n`m`f,Ï')" using â¹arity(p)â¤n⺠Nand by simp
have "arity(q) ⤠n" using Nand nand_ar2D by simp
moreover from this
have "i â arity(q) â¹ i â n" for i using subsetD[OF le_imp_subset[OF â¹arity(q) ⤠nâº]] by simp
moreover from this
have "i â arity(q) â¹ nth(i,Ï) = nth(f`i,Ï')" for i using Nand ltI by simp
moreover from this
have "sats(M,q,Ï) â· sats(M,ren(q)`n`m`f,Ï')" using assms â¹arity(q)â¤n⺠Nand by simp
ultimately
show ?case using Nand by simp
next
case (Forall p)
have 0:"ren(Forall(p))`n`m`f = Forall(ren(p)`succ(n)`succ(m)`sum_id(n,f))"
using Forall by simp
have 1:"sum_id(n,f) â succ(n) â succ(m)" (is "?g â _") using sum_id_tc Forall by simp
then have 2: "arity(p) ⤠succ(n)"
using Forall le_trans[of _ "succ(pred(arity(p)))"] succpred_leI by simp
have "succ(n)ânat" "succ(m)ânat" using Forall by auto
then have A:"â j .j < succ(n) â¹ nth(j, Cons(a, Ï)) = nth(?g`j, Cons(a, Ï'))" if "aâM" for a
using that env_coincidence_sum_id Forall ltD by force
have
"sats(M,p,Cons(a,Ï)) â· sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,Ï'))" if "aâM" for a
proof -
have C:"Cons(a,Ï) â list(M)" "Cons(a,Ï')âlist(M)" using Forall that by auto
have "sats(M,p,Cons(a,Ï)) â· sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,Ï'))"
using Forall(2)[OF â¹succ(n)ânat⺠â¹succ(m)ânat⺠C(1) C(2) 1 2 A[OF â¹aâMâº]] by simp
then show ?thesis .
qed
then show ?case using Forall 0 1 2 by simp
qed
endv class="head">
Theory Utils
theory Utils
imports "ZF-Constructible.Formula"
begin
txtâ¹This theory encapsulates some ML utilitiesâº
ML_fileâ¹Utils.mlâº
end
dy>
File â¹Utils.mlâº
signature Utils =
sig
val &&& : ('a -> 'b) * ('a -> 'c) -> 'a -> 'b * 'c
val *** : ('a -> 'b) * ('c -> 'd) -> 'a * 'c -> 'b * 'd
val @@ : ''a list * ''a list -> ''a list
val --- : ''a list * ''a list -> ''a list
val binop : term -> term -> term -> term
val add_: term -> term -> term
val add_to_context : string -> Proof.context -> Proof.context
val app_: term -> term -> term
val concat_: term -> term -> term
val dest_apply: term -> term * term
val dest_abs : string * typ * term -> string * term
val dest_iff_lhs: term -> term
val dest_iff_rhs: term -> term
val dest_iff_tms: term -> term * term
val dest_lhs_def: term -> term
val dest_rhs_def: term -> term
val dest_satisfies_tms: term -> term * term
val dest_satisfies_frm: term -> term
val dest_eq_tms: term -> term * term
val dest_mem_tms: term -> term * term
val dest_sats_frm: term -> (term * term) * term
val dest_eq_tms': term -> term * term
val dest_trueprop: term -> term
val display : string -> Position.T -> (string * thm list) * Proof.context -> Proof.context
val eq_: term -> term -> term
val fix_vars: thm -> string list -> Proof.context -> thm
val flat : ''a list list -> ''a list
val formula_: term
val freeName: term -> string
val frees : term -> term list
val length_: term -> term
val list_: term -> term
val lt_: term -> term -> term
val map_option : ('a -> 'b) -> 'a option -> 'b option
val mem_: term -> term -> term
val mk_FinSet: term list -> term
val mk_Pair: term -> term -> term
val mk_ZFlist: ('a -> term) -> 'a list -> term
val mk_ZFnat: int -> term
val nat_: term
val nth_: term -> term -> term
val reachable : (''a -> ''a -> bool) -> ''a list -> ''a list -> ''a list
val subset_: term -> term -> term
val thm_concl_tm : Proof.context -> xstring -> (Vars.key * cterm) list * term * Proof.context
val to_ML_list: term -> term list
val tp: term -> term
val var_i : string -> term
val zip_with : ('a * 'b -> 'c) -> 'a list -> 'b list -> 'c list
end
structure Utils : Utils =
struct
fun binop h t u = h $ t $ u
val mk_Pair = binop @{const Pair}
fun mk_FinSet nil = @{const zero}
| mk_FinSet (e :: es) = @{const cons} $ e $ mk_FinSet es
fun mk_ZFnat 0 = @{const zero}
| mk_ZFnat n = @{const succ} $ mk_ZFnat (n-1)
fun mk_ZFlist _ nil = @{const "Nil"}
| mk_ZFlist f (t :: ts) = @{const "Cons"} $ f t $ mk_ZFlist f ts
fun to_ML_list (@{const Nil}) = nil
| to_ML_list (@{const Cons} $ t $ ts) = t :: to_ML_list ts
| to_ML_list _ = nil
fun freeName (Free (n,_)) = n
| freeName _ = error "Not a free variable"
val app_ = binop @{const apply}
fun tp x = @{const Trueprop} $ x
fun length_ env = @{const length} $ env
val nth_ = binop @{const nth}
val add_ = binop @{const add}
val mem_ = binop @{const mem}
val subset_ = binop @{const Subset}
val lt_ = binop @{const lt}
val concat_ = binop @{const app}
val eq_ = binop @{const IFOL.eq(i)}
fun list_ set = @{const list} $ set
val nat_ = @{const nat}
val formula_ = @{const formula}
fun dest_eq_tms (Const (@{const_name IFOL.eq},_) $ t $ u) = (t, u)
| dest_eq_tms t = raise TERM ("dest_eq_tms", [t])
fun dest_mem_tms (@{const mem} $ t $ u) = (t, u)
| dest_mem_tms t = raise TERM ("dest_mem_tms", [t])
fun dest_eq_tms' (Const (@{const_name Pure.eq},_) $ t $ u) = (t, u)
| dest_eq_tms' t = raise TERM ("dest_eq_tms", [t])
val dest_lhs_def = #1 o dest_eq_tms'
val dest_rhs_def = #2 o dest_eq_tms'
fun dest_apply (@{const apply} $ t $ u) = (t,u)
| dest_apply t = raise TERM ("dest_applies_op", [t])
fun dest_satisfies_tms (@{const Formula.satisfies} $ A $ f) = (A,f)
| dest_satisfies_tms t = raise TERM ("dest_satisfies_tms", [t]);
val dest_satisfies_frm = #2 o dest_satisfies_tms
fun dest_sats_frm t = t |> dest_eq_tms |> #1 |> dest_apply |>> dest_satisfies_tms ;
fun dest_trueprop (@{const IFOL.Trueprop} $ t) = t
| dest_trueprop t = t
fun dest_iff_tms (@{const IFOL.iff} $ t $ u) = (t, u)
| dest_iff_tms t = raise TERM ("dest_iff_tms", [t])
val dest_iff_lhs = #1 o dest_iff_tms
val dest_iff_rhs = #2 o dest_iff_tms
fun thm_concl_tm ctxt thm_ref =
let
val thm = Proof_Context.get_thm ctxt thm_ref
val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
val (((_,inst),thm_tms),ctxt1) = Variable.import true [thm] ctxt
val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
in
(vars, thm_tms |> hd |> Thm.concl_of, ctxt1)
end
fun fix_vars thm vars ctxt = let
val (_, ctxt1) = Variable.add_fixes vars ctxt
in singleton (Proof_Context.export ctxt1 ctxt) thm
end
fun display kind pos (thms,thy) =
let val _ = Proof_Display.print_results true pos thy ((kind,""),[thms])
in thy
end
infix 6 @@
fun op @@ (xs, ys) = union (op =) ys xs
fun flat xss = fold (curry op @@) xss []
infix 6 ---
fun op --- (xs, ys) = subtract (op =) ys xs
infix 6 &&&
fun op &&& (f, g) = fn x => (f x, g x)
infix 6 ***
fun op *** (f, g) = fn (x, y) => (f x, g y)
fun add_to_context v c = if Variable.is_fixed c v then c else #2 (Variable.add_fixes [v] c)
fun frees t = fold_aterms (fn t => if is_Free t then cons t else I) t []
fun reachable p u xs =
let
val step = map (fn x => filter (p x) (u --- xs)) xs |> flat
val acc = if null step then [] else reachable p (u --- xs) step
in
xs @@ acc
end
fun zip_with _ [] _ = []
| zip_with _ _ [] = []
| zip_with f (x :: xs) (y :: ys) = f (x, y) :: zip_with f xs ys
fun var_i s = Free (s, @{typ "i"})
fun map_option f (SOME a) = SOME (f a)
| map_option _ NONE = NONE
fun dest_abs (v, ty, t) = (v, Term.subst_bound ((Free (v, ty)), t))
end
ody>
Theory Renaming_Auto
theory Renaming_Auto
imports
Renaming
Utils
keywords
"rename" :: thy_decl % "ML"
and
"simple_rename" :: thy_decl % "ML"
and
"src"
and
"tgt"
abbrevs
"simple_rename" = ""
begin
lemmas nat_succI = nat_succ_iff[THEN iffD2]
ML_fileâ¹Renaming_ML.mlâº
MLâ¹
open Renaming_ML
fun renaming_def mk_ren name from to ctxt =
let val to = to |> Syntax.read_term ctxt
val from = from |> Syntax.read_term ctxt
val (tc_lemma,action_lemma,fvs,r) = mk_ren from to ctxt
val (tc_lemma,action_lemma) = (fix_vars tc_lemma fvs ctxt , fix_vars action_lemma fvs ctxt)
val ren_fun_name = Binding.name (name ^ "_fn")
val ren_fun_def = Binding.name (name ^ "_fn_def")
val ren_thm = Binding.name (name ^ "_thm")
in
Local_Theory.note ((ren_thm, []), [tc_lemma,action_lemma]) ctxt |> snd |>
Local_Theory.define ((ren_fun_name, NoSyn), ((ren_fun_def, []), r)) |> snd
end;
âº
MLâ¹
local
val ren_parser = Parse.position (Parse.string --
(Parse.$$$ "src" |-- Parse.string --| Parse.$$$ "tgt" -- Parse.string));
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹rename⺠"ML setup for synthetic definitions"
(ren_parser >> (fn ((name,(from,to)),_) => renaming_def sum_rename name from to ))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹simple_rename⺠"ML setup for synthetic definitions"
(ren_parser >> (fn ((name,(from,to)),_) => renaming_def ren_thm name from to ))
in
end
âº
end
File â¹Renaming_ML.mlâº
structure Renaming_ML = struct
open Utils
fun sum_ f g m n p = @{const Renaming.rsum} $ f $ g $ m $ n $ p
fun mk_ren rho rho' ctxt =
let val rs = to_ML_list rho
val rs' = to_ML_list rho'
val ixs = 0 upto (length rs-1)
fun err t = "The element " ^ Syntax.string_of_term ctxt t ^ " is missing in the target environment"
fun mkp i =
case find_index (fn x => x = nth rs i) rs' of
~1 => nth rs i |> err |> error
| j => mk_Pair (mk_ZFnat i) (mk_ZFnat j)
in map mkp ixs |> mk_FinSet
end
fun mk_dom_lemma ren rho =
let val n = rho |> to_ML_list |> length |> mk_ZFnat
in eq_ n (@{const domain} $ ren) |> tp
end
fun ren_tc_goal fin ren rho rho' =
let val n = rho |> to_ML_list |> length |> mk_ZFnat
val m = rho' |> to_ML_list |> length |> mk_ZFnat
val fun_ty = if fin then @{const_name "FiniteFun"} else @{const_abbrev "function_space"}
val ty = Const (fun_ty,@{typ "i â i â i"}) $ n $ m
in mem_ ren ty |> tp
end
fun ren_action_goal ren rho rho' ctxt =
let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free
val vs = rho |> to_ML_list
val ws = rho' |> to_ML_list |> filter Term.is_Free
val h1 = subset_ (mk_FinSet vs) setV
val h2 = lt_ j (length vs |> mk_ZFnat)
val fvs = [j,setV ] @ ws |> filter Term.is_Free |> map freeName
val lhs = nth_ j rho
val rhs = nth_ (app_ ren j) rho'
val concl = eq_ lhs rhs
in (Logic.list_implies([tp h1,tp h2],tp concl),fvs)
end
fun sum_tc_goal f m n p =
let val m_length = m |> to_ML_list |> length |> mk_ZFnat
val n_length = n |> to_ML_list |> length |> mk_ZFnat
val p_length = p |> length_
val id_fun = @{const id} $ p_length
val sum_fun = sum_ f id_fun m_length n_length p_length
val dom = add_ m_length p_length
val codom = add_ n_length p_length
val fun_ty = @{const_abbrev "function_space"}
val ty = Const (fun_ty,@{typ "i â i â i"}) $ dom $ codom
in (sum_fun, mem_ sum_fun ty |> tp)
end
fun sum_action_goal ren rho rho' ctxt =
let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
val envV = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free
val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free
val vs = rho |> to_ML_list
val ws = rho' |> to_ML_list |> filter Term.is_Free
val envL = envV |> length_
val rhoL = vs |> length |> mk_ZFnat
val h1 = subset_ (append vs ws |> mk_FinSet) setV
val h2 = lt_ j (add_ rhoL envL)
val h3 = mem_ envV (list_ setV)
val fvs = ([j,setV,envV] @ ws |> filter Term.is_Free) |> map freeName
val lhs = nth_ j (concat_ rho envV)
val rhs = nth_ (app_ ren j) (concat_ rho' envV)
val concl = eq_ lhs rhs
in (Logic.list_implies([tp h1,tp h2,tp h3],tp concl),fvs)
end
fun fin ctxt =
REPEAT (resolve_tac ctxt [@{thm nat_succI}] 1)
THEN resolve_tac ctxt [@{thm nat_0I}] 1
fun step ctxt thm =
asm_full_simp_tac ctxt 1
THEN asm_full_simp_tac ctxt 1
THEN EqSubst.eqsubst_tac ctxt [1] [@{thm app_fun} OF [thm]] 1
THEN simp_tac ctxt 1
THEN simp_tac ctxt 1
fun fin_fun_tac ctxt =
REPEAT (
resolve_tac ctxt [@{thm consI}] 1
THEN resolve_tac ctxt [@{thm ltD}] 1
THEN simp_tac ctxt 1
THEN resolve_tac ctxt [@{thm ltD}] 1
THEN simp_tac ctxt 1)
THEN resolve_tac ctxt [@{thm emptyI}] 1
THEN REPEAT (simp_tac ctxt 1)
fun ren_thm e e' ctxt =
let
val r = mk_ren e e' ctxt
val fin_tc_goal = ren_tc_goal true r e e'
val dom_goal = mk_dom_lemma r e
val tc_goal = ren_tc_goal false r e e'
val (action_goal,fvs) = ren_action_goal r e e' ctxt
val fin_tc_lemma = Goal.prove ctxt [] [] fin_tc_goal (fn _ => fin_fun_tac ctxt)
val dom_lemma = Goal.prove ctxt [] [] dom_goal (fn _ => blast_tac ctxt 1)
val tc_lemma = Goal.prove ctxt [] [] tc_goal
(fn _ => EqSubst.eqsubst_tac ctxt [1] [dom_lemma] 1
THEN resolve_tac ctxt [@{thm FiniteFun_is_fun}] 1
THEN resolve_tac ctxt [fin_tc_lemma] 1)
val action_lemma = Goal.prove ctxt [] [] action_goal
(fn _ =>
forward_tac ctxt [@{thm le_natI}] 1
THEN fin ctxt
THEN REPEAT (resolve_tac ctxt [@{thm natE}] 1
THEN step ctxt tc_lemma)
THEN (step ctxt tc_lemma)
)
in (action_lemma, tc_lemma, fvs, r)
end
fun sum_ren_aux e e' ctxt =
let val env = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free
val (left_action_lemma,left_tc_lemma,_,r) = ren_thm e e' ctxt
val (sum_ren,sum_goal_tc) = sum_tc_goal r e e' env
val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
fun hyp en = mem_ en (list_ setV)
in (sum_ren,
freeName env,
Logic.list_implies (map (fn e => e |> hyp |> tp) [env], sum_goal_tc),
left_tc_lemma,
left_action_lemma)
end
fun sum_tc_lemma rho rho' ctxt =
let val (sum_ren, envVar, tc_goal, left_tc_lemma, left_action_lemma) = sum_ren_aux rho rho' ctxt
val (goal,fvs) = sum_action_goal sum_ren rho rho' ctxt
val r = mk_ren rho rho' ctxt
in (sum_ren, goal,envVar, r,left_tc_lemma, left_action_lemma ,fvs, Goal.prove ctxt [] [] tc_goal
(fn _ =>
resolve_tac ctxt [@{thm sum_type_id_aux2}] 1
THEN asm_simp_tac ctxt 4
THEN simp_tac ctxt 1
THEN resolve_tac ctxt [left_tc_lemma] 1
THEN (fin ctxt)
THEN (fin ctxt)
))
end
fun sum_rename rho rho' ctxt =
let
val (_, goal, _, left_rename, left_tc_lemma, left_action_lemma, fvs, sum_tc_lemma) =
sum_tc_lemma rho rho' ctxt
val action_lemma = fix_vars left_action_lemma fvs ctxt
in (sum_tc_lemma, Goal.prove ctxt [] [] goal
(fn _ => resolve_tac ctxt [@{thm sum_action_id_aux}] 1
THEN (simp_tac ctxt 4)
THEN (simp_tac ctxt 1)
THEN (resolve_tac ctxt [left_tc_lemma] 1)
THEN (asm_full_simp_tac ctxt 1)
THEN (asm_full_simp_tac ctxt 1)
THEN (simp_tac ctxt 1)
THEN (simp_tac ctxt 1)
THEN (simp_tac ctxt 1)
THEN (full_simp_tac ctxt 1)
THEN (resolve_tac ctxt [action_lemma] 1)
THEN (blast_tac ctxt 1)
THEN (full_simp_tac ctxt 1)
THEN (full_simp_tac ctxt 1)
), fvs, left_rename
)
end ;
end
Theory M_Basic_No_Repl
theory M_Basic_No_Repl
imports "ZF-Constructible.Relative"
begin
txtâ¹This locale is exactly \<^locale>â¹M_basic⺠without its only replacement
instance.âº
locale M_basic_no_repl = M_trivial +
assumes Inter_separation:
"M(A) ==> separation(M, λx. ây[M]. yâA ⶠxây)"
and Diff_separation:
"M(B) ==> separation(M, λx. x â B)"
and cartprod_separation:
"[| M(A); M(B) |]
==> separation(M, λz. âx[M]. xâA & (ây[M]. yâB & pair(M,x,y,z)))"
and image_separation:
"[| M(A); M(r) |]
==> separation(M, λy. âp[M]. pâr & (âx[M]. xâA & pair(M,x,y,p)))"
and converse_separation:
"M(r) ==> separation(M,
λz. âp[M]. pâr & (âx[M]. ây[M]. pair(M,x,y,p) & pair(M,y,x,z)))"
and restrict_separation:
"M(A) ==> separation(M, λz. âx[M]. xâA & (ây[M]. pair(M,x,y,z)))"
and comp_separation:
"[| M(r); M(s) |]
==> separation(M, λxz. âx[M]. ây[M]. âz[M]. âxy[M]. âyz[M].
pair(M,x,z,xz) & pair(M,x,y,xy) & pair(M,y,z,yz) &
xyâs & yzâr)"
and pred_separation:
"[| M(r); M(x) |] ==> separation(M, λy. âp[M]. pâr & pair(M,y,x,p))"
and Memrel_separation:
"separation(M, λz. âx[M]. ây[M]. pair(M,x,y,z) & x â y)"
and is_recfun_separation:
"[| M(r); M(f); M(g); M(a); M(b) |]
==> separation(M,
λx. âxa[M]. âxb[M].
pair(M,x,a,xa) & xa â r & pair(M,x,b,xb) & xb â r &
(âfx[M]. âgx[M]. fun_apply(M,f,x,fx) & fun_apply(M,g,x,gx) &
fx â gx))"
and power_ax: "power_ax(M)"
lemma (in M_basic_no_repl) cartprod_iff:
"[| M(A); M(B); M(C) |]
==> cartprod(M,A,B,C) â·
(âp1[M]. âp2[M]. powerset(M,A ⪠B,p1) & powerset(M,p1,p2) &
C = {z â p2. âxâA. âyâB. z = <x,y>})"
apply (simp add: Pair_def cartprod_def, safe)
defer 1
apply (simp add: powerset_def)
apply blast
txtâ¹Final, difficult case: the left-to-right direction of the theorem.âº
apply (insert power_ax, simp add: power_ax_def)
apply (frule_tac x="A ⪠B" and P="λx. rex(M,Q(x))" for Q in rspec)
apply (blast, clarify)
apply (drule_tac x=z and P="λx. rex(M,Q(x))" for Q in rspec)
apply assumption
apply (blast intro: cartprod_iff_lemma)
done
lemma (in M_basic_no_repl) cartprod_closed_lemma:
"[| M(A); M(B) |] ==> âC[M]. cartprod(M,A,B,C)"
apply (simp del: cartprod_abs add: cartprod_iff)
apply (insert power_ax, simp add: power_ax_def)
apply (frule_tac x="A ⪠B" and P="λx. rex(M,Q(x))" for Q in rspec)
apply (blast, clarify)
apply (drule_tac x=z and P="λx. rex(M,Q(x))" for Q in rspec, auto)
apply (intro rexI conjI, simp+)
apply (insert cartprod_separation [of A B], simp)
done
textâ¹All the lemmas above are necessary because Powerset is not absolute.
I should have used Replacement instead!âº
lemma (in M_basic_no_repl) cartprod_closed [intro,simp]:
"[| M(A); M(B) |] ==> M(A*B)"
by (frule cartprod_closed_lemma, assumption, force)
lemma (in M_basic_no_repl) sum_closed [intro,simp]:
"[| M(A); M(B) |] ==> M(A+B)"
by (simp add: sum_def)
lemma (in M_basic_no_repl) sum_abs [simp]:
"[| M(A); M(B); M(Z) |] ==> is_sum(M,A,B,Z) â· (Z = A+B)"
by (simp add: is_sum_def sum_def singleton_0 nat_into_M)
lemma (in M_basic_no_repl) M_converse_iff:
"M(r) ==>
converse(r) =
{z â â(â(r)) * â(â(r)).
âpâr. âx[M]. ây[M]. p = â¨x,yâ© & z = â¨y,xâ©}"
apply (rule equalityI)
prefer 2 apply (blast dest: transM, clarify, simp)
apply (simp add: Pair_def)
apply (blast dest: transM)
done
lemma (in M_basic_no_repl) converse_closed [intro,simp]:
"M(r) ==> M(converse(r))"
apply (simp add: M_converse_iff)
apply (insert converse_separation [of r], simp)
done
lemma (in M_basic_no_repl) converse_abs [simp]:
"[| M(r); M(z) |] ==> is_converse(M,r,z) â· z = converse(r)"
apply (simp add: is_converse_def)
apply (rule iffI)
prefer 2 apply blast
apply (rule M_equalityI)
apply simp
apply (blast dest: transM)+
done
subsubsection â¹image, preimage, domain, rangeâº
lemma (in M_basic_no_repl) image_closed [intro,simp]:
"[| M(A); M(r) |] ==> M(r``A)"
apply (simp add: image_iff_Collect)
apply (insert image_separation [of A r], simp)
done
lemma (in M_basic_no_repl) vimage_abs [simp]:
"[| M(r); M(A); M(z) |] ==> pre_image(M,r,A,z) â· z = r-``A"
apply (simp add: pre_image_def)
apply (rule iffI)
apply (blast intro!: equalityI dest: transM, blast)
done
lemma (in M_basic_no_repl) vimage_closed [intro,simp]:
"[| M(A); M(r) |] ==> M(r-``A)"
by (simp add: vimage_def)
subsubsectionâ¹Domain, range and fieldâº
lemma (in M_basic_no_repl) domain_closed [intro,simp]:
"M(r) ==> M(domain(r))"
apply (simp add: domain_eq_vimage)
done
lemma (in M_basic_no_repl) range_closed [intro,simp]:
"M(r) ==> M(range(r))"
apply (simp add: range_eq_image)
done
lemma (in M_basic_no_repl) field_abs [simp]:
"[| M(r); M(z) |] ==> is_field(M,r,z) â· z = field(r)"
by (simp add: is_field_def field_def)
lemma (in M_basic_no_repl) field_closed [intro,simp]:
"M(r) ==> M(field(r))"
by (simp add: field_def)
subsubsectionâ¹Relations, functions and applicationâº
lemma (in M_basic_no_repl) apply_closed [intro,simp]:
"[|M(f); M(a)|] ==> M(f`a)"
by (simp add: apply_def)
lemma (in M_basic_no_repl) apply_abs [simp]:
"[| M(f); M(x); M(y) |] ==> fun_apply(M,f,x,y) â· f`x = y"
apply (simp add: fun_apply_def apply_def, blast)
done
lemma (in M_basic_no_repl) injection_abs [simp]:
"[| M(A); M(f) |] ==> injection(M,A,B,f) â· f â inj(A,B)"
apply (simp add: injection_def apply_iff inj_def)
apply (blast dest: transM [of _ A])
done
lemma (in M_basic_no_repl) surjection_abs [simp]:
"[| M(A); M(B); M(f) |] ==> surjection(M,A,B,f) â· f â surj(A,B)"
by (simp add: surjection_def surj_def)
lemma (in M_basic_no_repl) bijection_abs [simp]:
"[| M(A); M(B); M(f) |] ==> bijection(M,A,B,f) â· f â bij(A,B)"
by (simp add: bijection_def bij_def)
subsubsectionâ¹Composition of relationsâº
lemma (in M_basic_no_repl) M_comp_iff:
"[| M(r); M(s) |]
==> r O s =
{xz â domain(s) * range(r).
âx[M]. ây[M]. âz[M]. xz = â¨x,zâ© & â¨x,yâ© â s & â¨y,zâ© â r}"
apply (simp add: comp_def)
apply (rule equalityI)
apply clarify
apply simp
apply (blast dest: transM)+
done
lemma (in M_basic_no_repl) comp_closed [intro,simp]:
"[| M(r); M(s) |] ==> M(r O s)"
apply (simp add: M_comp_iff)
apply (insert comp_separation [of r s], simp)
done
lemma (in M_basic_no_repl) composition_abs [simp]:
"[| M(r); M(s); M(t) |] ==> composition(M,r,s,t) â· t = r O s"
apply safe
txtâ¹Proving \<^term>â¹composition(M, r, s, r O s)âºâº
prefer 2
apply (simp add: composition_def comp_def)
apply (blast dest: transM)
txtâ¹Opposite implicationâº
apply (rule M_equalityI)
apply (simp add: composition_def comp_def)
apply (blast del: allE dest: transM)+
done
textâ¹no longer neededâº
lemma (in M_basic_no_repl) restriction_is_function:
"[| restriction(M,f,A,z); function(f); M(f); M(A); M(z) |]
==> function(z)"
apply (simp add: restriction_def ball_iff_equiv)
apply (unfold function_def, blast)
done
lemma (in M_basic_no_repl) restrict_closed [intro,simp]:
"[| M(A); M(r) |] ==> M(restrict(r,A))"
apply (simp add: M_restrict_iff)
apply (insert restrict_separation [of A], simp)
done
lemma (in M_basic_no_repl) Inter_closed [intro,simp]:
"M(A) ==> M(â(A))"
by (insert Inter_separation, simp add: Inter_def)
lemma (in M_basic_no_repl) Int_closed [intro,simp]:
"[| M(A); M(B) |] ==> M(A â© B)"
apply (subgoal_tac "M({A,B})")
apply (frule Inter_closed, force+)
done
lemma (in M_basic_no_repl) Diff_closed [intro,simp]:
"[|M(A); M(B)|] ==> M(A-B)"
by (insert Diff_separation, simp add: Diff_def)
subsubsectionâ¹Some Facts About Separation Axiomsâº
lemma (in M_basic_no_repl) separation_conj:
"[|separation(M,P); separation(M,Q)|] ==> separation(M, λz. P(z) & Q(z))"
by (simp del: separation_closed
add: separation_iff Collect_Int_Collect_eq [symmetric])
lemma (in M_basic_no_repl) separation_disj:
"[|separation(M,P); separation(M,Q)|] ==> separation(M, λz. P(z) | Q(z))"
by (simp del: separation_closed
add: separation_iff Collect_Un_Collect_eq [symmetric])
lemma (in M_basic_no_repl) separation_neg:
"separation(M,P) ==> separation(M, λz. ~P(z))"
by (simp del: separation_closed
add: separation_iff Diff_Collect_eq [symmetric])
lemma (in M_basic_no_repl) separation_imp:
"[|separation(M,P); separation(M,Q)|]
==> separation(M, λz. P(z) ⶠQ(z))"
by (simp add: separation_neg separation_disj not_disj_iff_imp [symmetric])
textâ¹This result is a hint of how little can be done without the Reflection
Theorem. The quantifier has to be bounded by a set. We also need another
instance of Separation!âº
lemma (in M_basic_no_repl) separation_rall:
"[|M(Y); ây[M]. separation(M, λx. P(x,y));
âz[M]. strong_replacement(M, λx y. y = {u â z . P(u,x)})|]
==> separation(M, λx. ây[M]. yâY ⶠP(x,y))"
apply (simp del: separation_closed rall_abs
add: separation_iff Collect_rall_eq)
apply (blast intro!: RepFun_closed dest: transM)
done
subsubsectionâ¹Functions and function spaceâº
lemma (in M_basic_no_repl) succ_fun_eq2:
"[|M(B); M(n->B)|] ==>
succ(n) -> B =
â{z. p â (n->B)*B, âf[M]. âb[M]. p = <f,b> & z = {cons(<n,b>, f)}}"
apply (simp add: succ_fun_eq)
apply (blast dest: transM)
done
lemma (in M_basic_no_repl) list_case'_closed [intro,simp]:
"[|M(k); M(a); âx[M]. ây[M]. M(b(x,y))|] ==> M(list_case'(a,b,k))"
apply (case_tac "quasilist(k)")
apply (simp add: quasilist_def, force)
apply (simp add: non_list_case)
done
lemma (in M_basic_no_repl) tl'_closed: "M(x) ==> M(tl'(x))"
apply (simp add: tl'_def)
apply (force simp add: quasilist_def)
done
sublocale M_basic â mbnr:M_basic_no_repl
using Inter_separation Diff_separation cartprod_separation image_separation
converse_separation restrict_separation comp_separation pred_separation
Memrel_separation is_recfun_separation power_ax by unfold_locales
end
body>
Theory Recursion_Thms
sectionâ¹Some enhanced theorems on recursionâº
theory Recursion_Thms
imports "ZF-Constructible.Datatype_absolute"
begin
declare arity_And [simp del] arity_Or[simp del] arity_Implies[simp del]
arity_Exists[simp del] arity_Iff[simp del]
arity_subset_fm [simp del] arity_ordinal_fm[simp del] arity_transset_fm[simp del]
textâ¹We prove results concerning definitions by well-founded
recursion on some relation \<^term>â¹R⺠and its transitive closure
\<^term>â¹R^*âºâº
lemma fld_restrict_eq : "a â A â¹ (r â© AÃA)-``{a} = (r-``{a} â© A)"
by(force)
lemma fld_restrict_mono : "relation(r) â¹ A â B â¹ r â© AÃA â r â© BÃB"
by(auto)
lemma fld_restrict_dom :
assumes "relation(r)" "domain(r) â A" "range(r)â A"
shows "râ© AÃA = r"
proof (rule equalityI,blast,rule subsetI)
{ fix x
assume xr: "x â r"
from xr assms have "â a b . x = â¨a,bâ©" by (simp add: relation_def)
then obtain a b where "â¨a,bâ© â r" "â¨a,bâ© â râ©AÃA" "x â râ©AÃA"
using assms xr
by force
then have "xâ r â© AÃA" by simp
}
then show "x â r â¹ xâ râ©AÃA" for x .
qed
definition tr_down :: "[i,i] â i"
where "tr_down(r,a) = (r^+)-``{a}"
lemma tr_downD : "x â tr_down(r,a) â¹ â¨x,aâ© â r^+"
by (simp add: tr_down_def vimage_singleton_iff)
lemma pred_down : "relation(r) â¹ r-``{a} â tr_down(r,a)"
by(simp add: tr_down_def vimage_mono r_subset_trancl)
lemma tr_down_mono : "relation(r) â¹ x â r-``{a} â¹ tr_down(r,x) â tr_down(r,a)"
by(rule subsetI,simp add:tr_down_def,auto dest: underD,force simp add: underI r_into_trancl trancl_trans)
lemma rest_eq :
assumes "relation(r)" and "r-``{a} â B" and "a â B"
shows "r-``{a} = (râ©BÃB)-``{a}"
proof (intro equalityI subsetI)
fix x
assume "x â r-``{a}"
then
have "x â B" using assms by (simp add: subsetD)
from â¹xâ r-``{a}âº
have "â¨x,aâ© â r" using underD by simp
then
show "x â (râ©BÃB)-``{a}" using â¹xâB⺠â¹aâB⺠underI by simp
next
from assms
show "x â r -`` {a}" if "x â (r â© BÃB) -`` {a}" for x
using vimage_mono that by auto
qed
lemma wfrec_restr_eq : "r' = r â© AÃA â¹ wfrec[A](r,a,H) = wfrec(r',a,H)"
by(simp add:wfrec_on_def)
lemma wfrec_restr :
assumes rr: "relation(r)" and wfr:"wf(r)"
shows "a â A â¹ tr_down(r,a) â A â¹ wfrec(r,a,H) = wfrec[A](r,a,H)"
proof (induct a arbitrary:A rule:wf_induct_raw[OF wfr] )
case (1 a)
have wfRa : "wf[A](r)"
using wf_subset wfr wf_on_def Int_lower1 by simp
from pred_down rr
have "r -`` {a} â tr_down(r, a)" .
with 1
have "r-``{a} â A" by (force simp add: subset_trans)
{
fix x
assume x_a : "x â r-``{a}"
with â¹r-``{a} â Aâº
have "x â A" ..
from pred_down rr
have b : "r -``{x} â tr_down(r,x)" .
then
have "tr_down(r,x) â tr_down(r,a)"
using tr_down_mono x_a rr by simp
with 1
have "tr_down(r,x) â A" using subset_trans by force
have "â¨x,aâ© â r" using x_a underD by simp
with 1 â¹tr_down(r,x) â A⺠â¹x â Aâº
have "wfrec(r,x,H) = wfrec[A](r,x,H)" by simp
}
then
have "xâ r-``{a} â¹ wfrec(r,x,H) = wfrec[A](r,x,H)" for x .
then
have Eq1 :"(λ x â r-``{a} . wfrec(r,x,H)) = (λ x â r-``{a} . wfrec[A](r,x,H))"
using lam_cong by simp
from assms
have "wfrec(r,a,H) = H(a,λ x â r-``{a} . wfrec(r,x,H))" by (simp add:wfrec)
also
have "... = H(a,λ x â r-``{a} . wfrec[A](r,x,H))"
using assms Eq1 by simp
also from 1 â¹r-``{a} â Aâº
have "... = H(a,λ x â (râ©AÃA)-``{a} . wfrec[A](r,x,H))"
using assms rest_eq by simp
also from â¹aâAâº
have "... = H(a,λ x â (r-``{a})â©A . wfrec[A](r,x,H))"
using fld_restrict_eq by simp
also from â¹aâA⺠â¹wf[A](r)âº
have "... = wfrec[A](r,a,H)" using wfrec_on by simp
finally show ?case .
qed
lemmas wfrec_tr_down = wfrec_restr[OF _ _ _ subset_refl]
lemma wfrec_trans_restr : "relation(r) â¹ wf(r) â¹ trans(r) â¹ r-``{a}âA â¹ a â A â¹
wfrec(r, a, H) = wfrec[A](r, a, H)"
by(subgoal_tac "tr_down(r,a) â A",auto simp add : wfrec_restr tr_down_def trancl_eq_r)
lemma field_trancl : "field(r^+) = field(r)"
by (blast intro: r_into_trancl dest!: trancl_type [THEN subsetD])
definition
Rrel :: "[iâiâo,i] â i" where
"Rrel(R,A) â¡ {zâAÃA. âx y. z = â¨x, y⩠⧠R(x,y)}"
lemma RrelI : "x â A â¹ y â A â¹ R(x,y) â¹ â¨x,yâ© â Rrel(R,A)"
unfolding Rrel_def by simp
lemma Rrel_mem: "Rrel(mem,x) = Memrel(x)"
unfolding Rrel_def Memrel_def ..
lemma relation_Rrel: "relation(Rrel(R,d))"
unfolding Rrel_def relation_def by simp
lemma field_Rrel: "field(Rrel(R,d)) â d"
unfolding Rrel_def by auto
lemma Rrel_mono : "A â B â¹ Rrel(R,A) â Rrel(R,B)"
unfolding Rrel_def by blast
lemma Rrel_restr_eq : "Rrel(R,A) â© BÃB = Rrel(R,Aâ©B)"
unfolding Rrel_def by blast
lemma field_Memrel : "field(Memrel(A)) â A"
using Rrel_mem field_Rrel by blast
lemma restrict_trancl_Rrel:
assumes "R(w,y)"
shows "restrict(f,Rrel(R,d)-``{y})`w
= restrict(f,(Rrel(R,d)^+)-``{y})`w"
proof (cases "yâd")
let ?r="Rrel(R,d)" and ?s="(Rrel(R,d))^+"
case True
show ?thesis
proof (cases "wâd")
case True
with â¹yâd⺠assms
have "â¨w,yâ©â?r"
unfolding Rrel_def by blast
then
have "â¨w,yâ©â?s"
using r_subset_trancl[of ?r] relation_Rrel[of R d] by blast
with â¹â¨w,yâ©â?râº
have "wâ?r-``{y}" "wâ?s-``{y}"
using vimage_singleton_iff by simp_all
then
show ?thesis by simp
next
case False
then
have "wâdomain(restrict(f,?r-``{y}))"
using subsetD[OF field_Rrel[of R d]] by auto
moreover from â¹wâdâº
have "wâdomain(restrict(f,?s-``{y}))"
using subsetD[OF field_Rrel[of R d], of w] field_trancl[of ?r]
fieldI1[of w y ?s] by auto
ultimately
have "restrict(f,?r-``{y})`w = 0" "restrict(f,?s-``{y})`w = 0"
unfolding apply_def by auto
then show ?thesis by simp
qed
next
let ?r="Rrel(R,d)"
let ?s="?r^+"
case False
then
have "?r-``{y}=0"
unfolding Rrel_def by blast
then
have "wâ?r-``{y}" by simp
with â¹yâd⺠assms
have "yâfield(?s)"
using field_trancl subsetD[OF field_Rrel[of R d]] by force
then
have "wâ?s-``{y}"
using vimage_singleton_iff by blast
with â¹wâ?r-``{y}âº
show ?thesis by simp
qed
lemma restrict_trans_eq:
assumes "w â y"
shows "restrict(f,Memrel(eclose({x}))-``{y})`w
= restrict(f,(Memrel(eclose({x}))^+)-``{y})`w"
using assms restrict_trancl_Rrel[of mem ] Rrel_mem by (simp)
lemma wf_eq_trancl:
assumes "â f y . H(y,restrict(f,R-``{y})) = H(y,restrict(f,R^+-``{y}))"
shows "wfrec(R, x, H) = wfrec(R^+, x, H)" (is "wfrec(?r,_,_) = wfrec(?r',_,_)")
proof -
have "wfrec(R, x, H) = wftrec(?r^+, x, λy f. H(y, restrict(f,?r-``{y})))"
unfolding wfrec_def ..
also
have " ... = wftrec(?r^+, x, λy f. H(y, restrict(f,(?r^+)-``{y})))"
using assms by simp
also
have " ... = wfrec(?r^+, x, H)"
unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
finally
show ?thesis .
qed
lemma transrec_equal_on_Ord:
assumes
"âx f . Ord(x) â¹ foo(x,f) = bar(x,f)"
"Ord(α)"
shows
"transrec(α, foo) = transrec(α, bar)"
proof -
have "transrec(β,foo) = transrec(β,bar)" if "Ord(β)" for β
using that
proof (induct rule:trans_induct)
case (step β)
have "transrec(β, foo) = foo(β, λxâβ. transrec(x, foo))"
using def_transrec[of "λx. transrec(x, foo)" foo] by blast
also from assms and step
have " ⦠= bar(β, λxâβ. transrec(x, foo))"
by simp
also from step
have " ⦠= bar(β, λxâβ. transrec(x, bar))"
by (auto)
also
have " ⦠= transrec(β, bar)"
using def_transrec[of "λx. transrec(x, bar)" bar, symmetric]
by blast
finally
show "transrec(β, foo) = transrec(β, bar)" .
qed
with assms
show ?thesis by simp
qed
lemma (in M_eclose) transrec_equal_on_M:
assumes
"âx f . M(x) â¹ M(f) â¹ foo(x,f) = bar(x,f)"
"âβ. M(β) â¹ transrec_replacement(M,is_foo,β)" "relation2(M,is_foo,foo)"
"strong_replacement(M, λx y. y = â¨x, transrec(x, foo)â©)"
"âx[M]. âg[M]. function(g) ⶠM(foo(x,g))"
"M(α)" "Ord(α)"
shows
"transrec(α, foo) = transrec(α, bar)"
proof -
have "M(transrec(x, foo))" if "Ord(x)" and "M(x)" for x
using that assms transrec_closed[of is_foo]
by simp
have "transrec(β,foo) = transrec(β,bar)" "M(transrec(β,foo))" if "Ord(β)" "M(β)" for β
using that
proof (induct rule:trans_induct)
case (step β)
moreover
assume "M(β)"
moreover
note â¹Ord(β)â¹ M(β) â¹ M(transrec(β, foo))âº
ultimately
show "M(transrec(β, foo))" by blast
with step â¹M(β)⺠â¹âx. Ord(x)â¹ M(x) â¹ M(transrec(x, foo))âº
â¹strong_replacement(M, λx y. y = â¨x, transrec(x, foo)â©)âº
have "M(λxâβ. transrec(x, foo))"
using Ord_in_Ord transM[of _ β]
by (rule_tac lam_closed) auto
have "transrec(β, foo) = foo(β, λxâβ. transrec(x, foo))"
using def_transrec[of "λx. transrec(x, foo)" foo] by blast
also from assms and â¹M(λxâβ. transrec(x, foo))⺠â¹M(β)âº
have " ⦠= bar(β, λxâβ. transrec(x, foo))"
by simp
also from step and â¹M(β)âº
have " ⦠= bar(β, λxâβ. transrec(x, bar))"
using transM[of _ β] by (auto)
also
have " ⦠= transrec(β, bar)"
using def_transrec[of "λx. transrec(x, bar)" bar, symmetric]
by blast
finally
show "transrec(β, foo) = transrec(β, bar)" .
qed
with assms
show ?thesis by simp
qed
lemma ordermap_restr_eq:
assumes "well_ord(X,r)"
shows "ordermap(X, r) = ordermap(X, r â© XÃX)"
proof -
let ?A="λx . Order.pred(X, x, r)"
let ?B="λx . Order.pred(X, x, r ⩠X à X)"
let ?F="λx f. f `` ?A(x)"
let ?G="λx f. f `` ?B(x)"
let ?P="λ z. zâX ⶠwfrec(r â© X à X,z,λx f. f `` ?A(x)) = wfrec(r â© X à X,z,λx f. f `` ?B(x))"
have pred_eq:
"Order.pred(X, x, r â© X Ã X) = Order.pred(X, x, r)" if "xâX" for x
unfolding Order.pred_def using that by auto
from assms
have wf_onX:"wf(r â© X Ã X)" unfolding well_ord_def wf_on_def by simp
{
have "?P(z)" for z
proof(induct rule:wf_induct[where P="?P",OF wf_onX])
case (1 x)
{
assume "xâX"
from 1
have lam_eq:
"(λwâ(r â© X à X) -`` {x}. wfrec(r â© X à X, w, ?F)) =
(λwâ(r â© X à X) -`` {x}. wfrec(r â© X à X, w, ?G))" (is "?L=?R")
proof -
have "wfrec(r â© X Ã X, w, ?F) = wfrec(r â© X Ã X, w, ?G)" if "wâ(râ©XÃX)-``{x}" for w
using 1 that by auto
then show ?thesis using lam_cong[OF refl] by simp
qed
then
have "wfrec(r â© X Ã X, x, ?F) = ?L `` ?A(x)"
using wfrec[OF wf_onX,of x ?F] by simp
also have "... = ?R `` ?B(x)"
using lam_eq pred_eq[OF â¹xâ_âº] by simp
also
have "... = wfrec(r â© X Ã X, x, ?G)"
using wfrec[OF wf_onX,of x ?G] by simp
finally
have "wfrec(r â© X Ã X, x, ?F) = wfrec(r â© X Ã X, x, ?G)" by simp
}
then
show ?case by simp
qed
}
then
show ?thesis
unfolding ordermap_def wfrec_on_def using Int_ac by simp
qed
end
d>
Theory Synthetic_Definition
sectionâ¹Automatic synthesis of formulasâº
theory Synthetic_Definition
imports
Utils
keywords
"synthesize" :: thy_decl % "ML"
and
"synthesize_notc" :: thy_decl % "ML"
and
"generate_schematic" :: thy_decl % "ML"
and
"arity_theorem" :: thy_decl % "ML"
and
"manual_schematic" :: thy_goal_stmt % "ML"
and
"manual_arity" :: thy_goal_stmt % "ML"
and
"from_schematic"
and
"for"
and
"from_definition"
and
"assuming"
and
"intermediate"
begin
named_theorems fm_definitions "Definitions of synthetized formulas."
named_theorems iff_sats "Theorems for synthetising formulas."
named_theorems arity "Theorems for arity of formulas."
named_theorems arity_aux "Auxiliary theorems for calculating arities."
MLâ¹
val $` = curry ((op $) o swap)
infix $`
infix 6 &&&
val op &&& = Utils.&&&
infix 6 ***
val op *** = Utils.***
fun arity_goal intermediate def_name lthy =
let
val thm = Proof_Context.get_thm lthy (def_name ^ "_def")
val (_, tm, _) = Utils.thm_concl_tm lthy (def_name ^ "_def")
val (def, tm) = tm |> Utils.dest_eq_tms'
fun first_lambdas (Abs (body as (_, ty, _))) =
if ty = @{typ "i"}
then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
else Utils.dest_abs body |> first_lambdas o #2
| first_lambdas _ = []
val (def, vars) = Term.strip_comb def
val vs = vars @ first_lambdas tm
val def = fold (op $`) vs def
val hyps = map (fn v => Utils.mem_ v Utils.nat_ |> Utils.tp) vs
val concl = @{const IFOL.eq(i)} $ (@{const arity} $ def) $ Var (("ar", 0), @{typ "i"})
val g_iff = Logic.list_implies (hyps, Utils.tp concl)
val attribs = if intermediate then [] else @{attributes [arity]}
in
(g_iff, "arity_" ^ def_name ^ (if intermediate then "'" else ""), attribs, thm, vs)
end
fun manual_arity intermediate def_name pos lthy =
let
val (goal, thm_name, attribs, _, _) = arity_goal intermediate def_name lthy
in
Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
o Local_Theory.note ((Binding.name thm_name, attribs), hd thmss))
[[(goal, [])]] lthy
end
fun prove_arity thms goal ctxt =
let
val rules = (Named_Theorems.get ctxt \<^named_theorems>â¹arityâº) @
(Named_Theorems.get ctxt \<^named_theorems>â¹arity_auxâº)
in
Goal.prove ctxt [] [] goal
(K (rewrite_goal_tac ctxt thms 1 THEN Method.insert_tac ctxt rules 1 THEN asm_simp_tac ctxt 1))
end
fun auto_arity intermediate def_name pos lthy =
let
val (goal, thm_name, attribs, def_thm, vs) = arity_goal intermediate def_name lthy
val intermediate_text = if intermediate then "intermediate" else ""
val help = "You can manually prove the arity_theorem by typing:\n"
^ "manual_arity " ^ intermediate_text ^ " for \"" ^ def_name ^ "\"\n"
val thm = prove_arity [def_thm] goal lthy
handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
val thm = Utils.fix_vars thm (map Utils.freeName vs) lthy
in
Local_Theory.note ((Binding.name thm_name, attribs), [thm]) lthy |> Utils.display "theorem" pos
end
fun prove_tc_form goal thms ctxt =
Goal.prove ctxt [] [] goal (K (rewrite_goal_tac ctxt thms 1 THEN auto_tac ctxt))
fun prove_sats_tm thm_auto thms goal ctxt =
let
val ctxt' = ctxt |> Simplifier.add_simp (hd thm_auto)
in
Goal.prove ctxt [] [] goal
(K (rewrite_goal_tac ctxt thms 1 THEN PARALLEL_ALLGOALS (asm_simp_tac ctxt')))
end
fun prove_sats_iff goal ctxt = Goal.prove ctxt [] [] goal (K (asm_simp_tac ctxt 1))
fun is_mem (@{const mem} $ _ $ _) = true
| is_mem _ = false
fun pre_synth_thm_sats term set env vars vs lthy =
let
val (_, tm, ctxt1) = Utils.thm_concl_tm lthy term
val (thm_refs, ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
val vs' = map (Thm.term_of o #2) vs
val vars' = map (Thm.term_of o #2) vars
val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vs'
val sats = @{const apply} $ (@{const satisfies} $ set $ r_tm) $ env
val sats' = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
in
{ vars = vars'
, vs = vs'
, sats = sats'
, thm_refs = thm_refs
, lthy = ctxt2
, env = env
, set = set
}
end
fun synth_thm_sats_gen name lhs hyps pos attribs aux_funs environment lthy =
let
val ctxt = (#prepare_ctxt aux_funs) lthy
val ctxt = Utils.add_to_context (Utils.freeName (#set environment)) ctxt
val (new_vs, ctxt') = (#create_variables aux_funs) (#vs environment, ctxt)
val new_hyps = (#create_hyps aux_funs) (#vs environment, new_vs)
val concl = (#make_concl aux_funs) (lhs, #sats environment, new_vs)
val g_iff = Logic.list_implies (new_hyps @ hyps, Utils.tp concl)
val thm = (#prover aux_funs) g_iff ctxt'
val thm = Utils.fix_vars thm (map Utils.freeName ((#vars environment) @ new_vs)) lthy
in
Local_Theory.note ((name, attribs), [thm]) lthy |> Utils.display "theorem" pos
end
fun synth_thm_sats_iff def_name lhs hyps pos environment =
let
val subst = Utils.zip_with (I *** I) (#vs environment)
fun subst_nth (@{const "nth"} $ v $ _) new_vs = AList.lookup (op =) (subst new_vs) v |> the
| subst_nth (t1 $ t2) new_vs = (subst_nth t1 new_vs) $ (subst_nth t2 new_vs)
| subst_nth (Abs (v, ty, t)) new_vs = Abs (v, ty, subst_nth t new_vs)
| subst_nth t _ = t
val name = Binding.name (def_name ^ "_iff_sats")
val iff_sats_attrib = @{attributes [iff_sats]}
val aux_funs = { prepare_ctxt = fold Utils.add_to_context (map Utils.freeName (#vs environment))
, create_variables = fn (vs, ctxt) => Variable.variant_fixes (map Utils.freeName vs) ctxt |>> map Utils.var_i
, create_hyps = fn (vs, new_vs) => Utils.zip_with (fn (v, nv) => Utils.eq_ (Utils.nth_ v (#env environment)) nv) vs new_vs |> map Utils.tp
, make_concl = fn (lhs, rhs, new_vs) => @{const IFOL.iff} $ (subst_nth lhs new_vs) $ rhs
, prover = prove_sats_iff
}
in
synth_thm_sats_gen name lhs hyps pos iff_sats_attrib aux_funs environment
end
fun synth_thm_sats_fm def_name lhs hyps pos thm_auto environment =
let
val name = Binding.name ("sats_" ^ def_name ^ "_fm")
val simp_attrib = @{attributes [simp]}
val aux_funs = { prepare_ctxt = I
, create_variables = K [] *** I
, create_hyps = K []
, make_concl = fn (rhs, lhs, _) => @{const IFOL.iff} $ lhs $ rhs
, prover = prove_sats_tm thm_auto (#thm_refs environment)
}
in
synth_thm_sats_gen name lhs hyps pos simp_attrib aux_funs environment
end
fun synth_thm_tc def_name term hyps vars pos lthy =
let
val (_,tm,ctxt1) = Utils.thm_concl_tm lthy term
val (thm_refs,ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
val vars' = map (Thm.term_of o #2) vars
val tc_attrib = @{attributes [TC]}
val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vars'
val concl = @{const mem} $ r_tm $ @{const formula}
val g = Logic.list_implies(hyps, Utils.tp concl)
val thm = prove_tc_form g thm_refs ctxt2
val name = Binding.name (def_name ^ "_fm_type")
val thm = Utils.fix_vars thm (map Utils.freeName vars') ctxt2
in
Local_Theory.note ((name, tc_attrib), [thm]) lthy |> Utils.display "theorem" pos
end
fun synthetic_def def_name thm_ref pos tc auto thy =
let
val thm = Proof_Context.get_thm thy thm_ref
val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
val (((_,inst),thm_tms),_) = Variable.import true [thm] thy
val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
val (tm,hyps) = thm_tms |> hd |> Thm.concl_of &&& Thm.prems_of
val (lhs,rhs) = tm |> Utils.dest_iff_tms o Utils.dest_trueprop
val ((set,t),env) = rhs |> Utils.dest_sats_frm
fun relevant ts (@{const mem} $ t $ _) =
(not (t = @{term "0"})) andalso
(not (Term.is_Free t) orelse member (op =) ts (t |> Term.dest_Free |> #1))
| relevant _ _ = false
val t_vars = sort_strings (Term.add_free_names t [])
val vs = filter (Ord_List.member String.compare t_vars o #1 o #1 o #1) vars
val at = fold_rev (lambda o Thm.term_of o #2) vs t
val hyps' = filter (relevant t_vars o Utils.dest_trueprop) hyps
val def_attrs = @{attributes [fm_definitions]}
in
Local_Theory.define ((Binding.name (def_name ^ "_fm"), NoSyn),
((Binding.name (def_name ^ "_fm_def"), def_attrs), at)) thy
|>> (#2 #> I *** single) |> Utils.display "theorem" pos |>
(if tc then synth_thm_tc def_name (def_name ^ "_fm_def") hyps' vs pos else I) |>
(if auto then
pre_synth_thm_sats (def_name ^ "_fm_def") set env vars vs
#> I &&& #lthy
#> #1 &&& uncurry (synth_thm_sats_fm def_name lhs hyps pos thm_tms)
#> uncurry (synth_thm_sats_iff def_name lhs hyps pos)
else I)
end
fun prove_schematic thms goal ctxt =
let
val rules = Named_Theorems.get ctxt \<^named_theorems>â¹iff_satsâº
in
Goal.prove ctxt [] [] goal
(K (rewrite_goal_tac ctxt thms 1 THEN REPEAT1 (CHANGED (resolve_tac ctxt rules 1 ORELSE asm_simp_tac ctxt 1))))
end
val valid_assumptions = [ ("nonempty", Utils.mem_ @{term "0"})
]
fun pre_schematic_def target assuming lthy =
let
val thm = Proof_Context.get_thm lthy (target ^ "_def")
val (vars, tm, ctxt1) = Utils.thm_concl_tm lthy (target ^ "_def")
val (const, tm) = tm |> Utils.dest_eq_tms' o Utils.dest_trueprop |>> #1 o strip_comb
val t_vars = sort_strings (Term.add_free_names tm [])
val vs = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
|> List.filter ((curry op = @{typ "i"}) o #2 o #1)
|> List.map (Utils.var_i o #1 o #1 o #1)
fun first_lambdas (Abs (body as (_, ty, _))) =
if ty = @{typ "i"}
then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
else Utils.dest_abs body |> first_lambdas o #2
| first_lambdas _ = []
val vs = vs @ (first_lambdas tm)
val ctxt1' = fold Utils.add_to_context (map Utils.freeName vs) ctxt1
val (set, ctxt2) = Variable.variant_fixes ["A"] ctxt1' |>> Utils.var_i o hd
val class = @{const "setclass"} $ set
val (env, ctxt3) = Variable.variant_fixes ["env"] ctxt2 |>> Utils.var_i o hd
val assumptions = filter (member (op =) assuming o #1) valid_assumptions |> map #2
val hyps = (List.map (fn v => Utils.tp (Utils.mem_ v Utils.nat_)) vs)
@ [Utils.tp (Utils.mem_ env (Utils.list_ set))]
@ Utils.zip_with (fn (f,x) => Utils.tp (f x)) assumptions (replicate (length assumptions) set)
val args = class :: map (fn v => Utils.nth_ v env) vs
val (fm_name, ctxt4) = Variable.variant_fixes ["fm"] ctxt3 |>> hd
val fm_type = fold (K (fn acc => Type ("fun", [@{typ "i"}, acc]))) vs @{typ "i"}
val fm = Var ((fm_name, 0), fm_type)
val lhs = fold (op $`) args const
val fm_app = fold (op $`) vs fm
val sats = @{const apply} $ (@{const satisfies} $ set $ fm_app) $ env
val rhs = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
val concl = @{const "IFOL.iff"} $ lhs $ rhs
val schematic = Logic.list_implies (hyps, Utils.tp concl)
in
(schematic, ctxt4, thm, set, env, vs)
end
fun str_join _ [] = ""
| str_join _ [s] = s
| str_join c (s :: ss) = s ^ c ^ (str_join c ss)
fun schematic_def def_name target assuming pos lthy =
let
val (schematic, ctxt, thm, set, env, vs) = pre_schematic_def target assuming lthy
val assuming_text = if null assuming then "" else "assuming " ^ (map (fn s => "\"" ^ s ^ "\"") assuming |> str_join " ")
val help = "You can manually prove the schematic_goal by typing:\n"
^ "manual_schematic [sch_name] for \"" ^ target ^ "\"" ^ assuming_text ^"\n"
^ "And then complete the synthesis with:\n"
^ "synthesize \"" ^ target ^ "\" from_schematic [sch_name]\n"
^ "In both commands, «sch_name» must be the same and, if ommited, will be defaulted to sats_" ^ target ^ "_fm_auto.\n"
^ "You can also try adding new assumptions and/or synthetizing definitions of sub-terms."
val thm = prove_schematic [thm] schematic ctxt
handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
val thm = Utils.fix_vars thm (map Utils.freeName (set :: env :: vs)) lthy
in
Local_Theory.note ((Binding.name def_name, []), [thm]) lthy |> Utils.display "theorem" pos
end
fun schematic_synthetic_def def_name target assuming pos tc auto =
(synthetic_def def_name ("sats_" ^ def_name ^ "_fm_auto") pos tc auto)
o (schematic_def ("sats_" ^ def_name ^ "_fm_auto") target assuming pos)
fun manual_schematic def_name target assuming pos lthy =
let
val (schematic, _, _, _, _, _) = pre_schematic_def target assuming lthy
in
Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
o Local_Theory.note ((Binding.name def_name, []), hd thmss))
[[(schematic, [])]] lthy
end
âº
MLâ¹
local
val simple_from_schematic_synth_constdecl =
Parse.string --| (Parse.$$$ "from_schematic")
>> (fn bndg => synthetic_def bndg ("sats_" ^ bndg ^ "_fm_auto"))
val full_from_schematic_synth_constdecl =
Parse.string -- ((Parse.$$$ "from_schematic" |-- Parse.thm))
>> (fn (bndg,thm) => synthetic_def bndg (#1 (thm |>> Facts.ref_name)))
val full_from_definition_synth_constdecl =
Parse.string -- ((Parse.$$$ "from_definition" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
>> (fn ((bndg,target), assuming) => schematic_synthetic_def bndg target assuming)
val simple_from_definition_synth_constdecl =
Parse.string -- (Parse.$$$ "from_definition" |-- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string)) [])
>> (fn (bndg, assuming) => schematic_synthetic_def bndg bndg assuming)
val synth_constdecl =
Parse.position (full_from_schematic_synth_constdecl || simple_from_schematic_synth_constdecl
|| full_from_definition_synth_constdecl
|| simple_from_definition_synth_constdecl)
val full_schematic_decl =
Parse.string -- ((Parse.$$$ "for" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
val simple_schematic_decl =
(Parse.$$$ "for" |-- Parse.string >> (fn name => "sats_" ^ name ^ "_fm_auto") &&& I) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
val schematic_decl = Parse.position (full_schematic_decl || simple_schematic_decl)
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹synthesize⺠"ML setup for synthetic definitions"
(synth_constdecl >> (fn (f,p) => f p true true))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹synthesize_notc⺠"ML setup for synthetic definitions"
(synth_constdecl >> (fn (f,p) => f p false false))
val _ = Outer_Syntax.local_theory \<^command_keyword>â¹generate_schematic⺠"ML setup for schematic goals"
(schematic_decl >> (fn (((bndg,target), assuming),p) => schematic_def bndg target assuming p))
val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>â¹manual_schematic⺠"ML setup for schematic goals"
(schematic_decl >> (fn (((bndg,target), assuming),p) => manual_schematic bndg target assuming p))
val arity_parser = Parse.position ((Scan.option (Parse.$$$ "intermediate") >> is_some) -- (Parse.$$$ "for" |-- Parse.string))
val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>â¹manual_arity⺠"ML setup for arities"
(arity_parser >> (fn ((intermediate, target), pos) => manual_arity intermediate target pos))
val _ = Outer_Syntax.local_theory \<^command_keyword>â¹arity_theorem⺠"ML setup for arities"
(arity_parser >> (fn ((intermediate, target), pos) => auto_arity intermediate target pos))
in
end
âº
textâ¹The \<^ML>â¹synthetic_def⺠function extracts definitions from
schematic goals. A new definition is added to the context. âº
end
Theory Internalizations
sectionâ¹Aids to internalize formulasâº
theory Internalizations
imports
"ZF-Constructible.DPow_absolute"
Synthetic_Definition
Nat_Miscellanea
begin
definition
infinity_ax :: "(i â o) â o" where
"infinity_ax(M) â¡
(âI[M]. (âz[M]. empty(M,z) ⧠zâI) ⧠(ây[M]. yâI ⶠ(âsy[M]. successor(M,y,sy) ⧠syâI)))"
definition
wellfounded_trancl :: "[i=>o,i,i,i] => o" where
"wellfounded_trancl(M,Z,r,p) â¡
âw[M]. âwx[M]. ârp[M].
w â Z & pair(M,w,p,wx) & tran_closure(M,r,rp) & wx â rp"
lemma empty_intf :
"infinity_ax(M) â¹
(âz[M]. empty(M,z))"
by (auto simp add: empty_def infinity_ax_def)
lemma Transset_intf :
"Transset(M) â¹ yâx â¹ x â M â¹ y â M"
by (simp add: Transset_def,auto)
definition
choice_ax :: "(iâo) â o" where
"choice_ax(M) â¡ âx[M]. âa[M]. âf[M]. ordinal(M,a) ⧠surjection(M,a,x,f)"
lemma (in M_basic) choice_ax_abs :
"choice_ax(M) â· (âx[M]. âa[M]. âf[M]. Ord(a) ⧠f â surj(a,x))"
unfolding choice_ax_def
by simp
txtâ¹Setting up notation for internalized formulasâº
abbreviation
dec10 :: i ("10") where "10 â¡ succ(9)"
abbreviation
dec11 :: i ("11") where "11 â¡ succ(10)"
abbreviation
dec12 :: i ("12") where "12 â¡ succ(11)"
abbreviation
dec13 :: i ("13") where "13 â¡ succ(12)"
abbreviation
dec14 :: i ("14") where "14 â¡ succ(13)"
abbreviation
dec15 :: i ("15") where "15 â¡ succ(14)"
abbreviation
dec16 :: i ("16") where "16 â¡ succ(15)"
abbreviation
dec17 :: i ("17") where "17 â¡ succ(16)"
abbreviation
dec18 :: i ("18") where "18 â¡ succ(17)"
abbreviation
dec19 :: i ("19") where "19 â¡ succ(18)"
abbreviation
dec20 :: i ("20") where "20 â¡ succ(19)"
abbreviation
dec21 :: i ("21") where "21 â¡ succ(20)"
abbreviation
dec22 :: i ("22") where "22 â¡ succ(21)"
abbreviation
dec23 :: i ("23") where "23 â¡ succ(22)"
abbreviation
dec24 :: i ("24") where "24 â¡ succ(23)"
abbreviation
dec25 :: i ("25") where "25 â¡ succ(24)"
abbreviation
dec26 :: i ("26") where "26 â¡ succ(25)"
abbreviation
dec27 :: i ("27") where "27 â¡ succ(26)"
abbreviation
dec28 :: i ("28") where "28 â¡ succ(27)"
abbreviation
dec29 :: i ("29") where "29 â¡ succ(28)"
notation Member (â¹â
_ â/ _â
âº)
notation Equal (â¹â
_ =/ _â
âº)
notation Nand (â¹â
¬'(_ â§/ _')â
âº)
notation And (â¹â
_ â§/ _â
âº)
notation Or (â¹â
_ â¨/ _â
âº)
notation Iff (â¹â
_ â/ _â
âº)
notation Implies (â¹â
_ â/ _â
âº)
notation Neg (â¹â
¬_â
âº)
notation Forall (â¹'(â
â(/_)â
')âº)
notation Exists (â¹'(â
â(/_)â
')âº)
notation subset_fm (â¹â
_ â/ _â
âº)
notation succ_fm (â¹â
succ'(_') is _â
âº)
notation empty_fm (â¹â
_ is emptyâ
âº)
notation fun_apply_fm (â¹â
_`_ is _â
âº)
notation big_union_fm (â¹â
â_ is _â
âº)
notation upair_fm (â¹â
{_,_} is _ â
âº)
notation ordinal_fm (â¹â
_ is ordinalâ
âº)
notation pair_fm (â¹â
â¨_,_â© is _ â
âº)
notation composition_fm (â¹â
_ â _ is _ â
âº)
notation domain_fm (â¹â
dom'(_') is _ â
âº)
notation range_fm (â¹â
ran'(_') is _ â
âº)
notation union_fm (â¹â
_ ⪠_ is _ â
âº)
notation image_fm (â¹â
_ `` _ is _ â
âº)
notation pre_image_fm (â¹â
_ -`` _ is _ â
âº)
notation field_fm (â¹â
fld'(_') is _ â
âº)
notation cons_fm (â¹â
cons'(_,_') is _ â
âº)
notation number1_fm (â¹â
_ is the number oneâ
âº)
notation function_fm (â¹â
_ is functâ
âº)
notation relation_fm (â¹â
_ is relatâ
âº)
notation restriction_fm (â¹â
_ â¾ _ is _ â
âº)
notation transset_fm (â¹â
_ is transitiveâ
âº)
notation limit_ordinal_fm (â¹â
_ is limitâ
âº)
notation finite_ordinal_fm (â¹â
_ is finite ordâ
âº)
notation omega_fm (â¹â
_ is Ïâ
âº)
notation cartprod_fm (â¹â
_ Ã _ is _â
âº)
notation Memrel_fm (â¹â
Memrel'(_') is _â
âº)
notation quasinat_fm (â¹â
_ is qnatâ
âº)
notation Inl_fm (â¹â
Inl'(_') is _ â
âº)
notation Inr_fm (â¹â
Inr'(_') is _ â
âº)
notation pred_set_fm (â¹â
_-predecessors of _ are _â
âº)
abbreviation
fm_typedfun :: "[i,i,i] â i" (â¹â
_ : _ â _â
âº) where
"fm_typedfun(f,A,B) â¡ typed_function_fm(A,B,f)"
abbreviation
fm_surjection :: "[i,i,i] â i" (â¹â
_ surjects _ to _â
âº) where
"fm_surjection(f,A,B) â¡ surjection_fm(A,B,f)"
abbreviation
fm_injection :: "[i,i,i] â i" (â¹â
_ injects _ to _â
âº) where
"fm_injection(f,A,B) â¡ injection_fm(A,B,f)"
abbreviation
fm_bijection :: "[i,i,i] â i" (â¹â
_ bijects _ to _â
âº) where
"fm_bijection(f,A,B) â¡ bijection_fm(A,B,f)"
textâ¹We found it useful to have slightly different versions of some
results in ZF-Constructible:âº
lemma nth_closed :
assumes "envâlist(A)" "0âA"
shows "nth(n,env)âA"
using assms unfolding nth_def by (induct env; simp)
lemma conj_setclass_model_iff_sats [iff_sats]:
"[| 0 â A; nth(i,env) = x; env â list(A);
P â· sats(A,p,env); env â list(A) |]
==> (P ⧠(##A)(x)) ⷠsats(A, p, env)"
"[| 0 â A; nth(i,env) = x; env â list(A);
P â· sats(A,p,env); env â list(A) |]
==> ((##A)(x) ⧠P) ⷠsats(A, p, env)"
using nth_closed[of env A i]
by auto
lemma conj_mem_model_iff_sats [iff_sats]:
"[| 0 â A; nth(i,env) = x; env â list(A);
P â· sats(A,p,env); env â list(A) |]
==> (P ⧠x â A) â· sats(A, p, env)"
"[| 0 â A; nth(i,env) = x; env â list(A);
P â· sats(A,p,env); env â list(A) |]
==> (x â A ⧠P) â· sats(A, p, env)"
using nth_closed[of env A i]
by auto
lemma mem_model_iff_sats [iff_sats]:
"[| 0 â A; nth(i,env) = x; env â list(A)|]
==> (xâA) â· sats(A, Exists(Equal(0,0)), env)"
using nth_closed[of env A i]
by auto
lemma subset_iff_sats[iff_sats]:
"nth(i, env) = x â¹ nth(j, env) = y â¹ iânat â¹ jânat â¹
env â list(A) â¹ subset(##A, x, y) â· sats(A, subset_fm(i, j), env)"
using sats_subset_fm' by simp
lemma not_mem_model_iff_sats [iff_sats]:
"[| 0 â A; nth(i,env) = x; env â list(A)|]
==> (â x . x â A) â· sats(A, Neg(Exists(Equal(0,0))), env)"
by auto
lemma top_iff_sats [iff_sats]:
"env â list(A) â¹ 0 â A â¹ sats(A, Exists(Equal(0,0)), env)"
by auto
lemma prefix1_iff_sats[iff_sats]:
assumes
"x â nat" "env â list(A)" "0 â A" "a â A"
shows
"a = nth(x,env) â· sats(A, Equal(0,x+â©Ï1), Cons(a,env))"
"nth(x,env) = a â· sats(A, Equal(x+â©Ï1,0), Cons(a,env))"
"a â nth(x,env) â· sats(A, Member(0,x+â©Ï1), Cons(a,env))"
"nth(x,env) â a â· sats(A, Member(x+â©Ï1,0), Cons(a,env))"
using assms nth_closed
by simp_all
lemma prefix2_iff_sats[iff_sats]:
assumes
"x â nat" "env â list(A)" "0 â A" "a â A" "b â A"
shows
"b = nth(x,env) â· sats(A, Equal(1,x+â©Ï2), Cons(a,Cons(b,env)))"
"nth(x,env) = b â· sats(A, Equal(x+â©Ï2,1), Cons(a,Cons(b,env)))"
"b â nth(x,env) â· sats(A, Member(1,x+â©Ï2), Cons(a,Cons(b,env)))"
"nth(x,env) â b â· sats(A, Member(x+â©Ï2,1), Cons(a,Cons(b,env)))"
using assms nth_closed
by simp_all
lemma prefix3_iff_sats[iff_sats]:
assumes
"x â nat" "env â list(A)" "0 â A" "a â A" "b â A" "c â A"
shows
"c = nth(x,env) â· sats(A, Equal(2,x+â©Ï3), Cons(a,Cons(b,Cons(c,env))))"
"nth(x,env) = c â· sats(A, Equal(x+â©Ï3,2), Cons(a,Cons(b,Cons(c,env))))"
"c â nth(x,env) â· sats(A, Member(2,x+â©Ï3), Cons(a,Cons(b,Cons(c,env))))"
"nth(x,env) â c â· sats(A, Member(x+â©Ï3,2), Cons(a,Cons(b,Cons(c,env))))"
using assms nth_closed
by simp_all
lemmas FOL_sats_iff = sats_Nand_iff sats_Forall_iff sats_Neg_iff sats_And_iff
sats_Or_iff sats_Implies_iff sats_Iff_iff sats_Exists_iff
lemma nth_ConsI: "â¦nth(n,l) = x; n â nat⧠⹠nth(succ(n), Cons(a,l)) = x"
by simp
lemmas nth_rules = nth_0 nth_ConsI nat_0I nat_succI
lemmas sep_rules = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
fun_plus_iff_sats successor_iff_sats
omega_iff_sats FOL_sats_iff Replace_iff_sats
textâ¹Also a different compilation of lemmas (termâ¹sep_rulesâº) used in formula
synthesisâº
lemmas fm_defs =
omega_fm_def limit_ordinal_fm_def empty_fm_def typed_function_fm_def
pair_fm_def upair_fm_def domain_fm_def function_fm_def succ_fm_def
cons_fm_def fun_apply_fm_def image_fm_def big_union_fm_def union_fm_def
relation_fm_def composition_fm_def field_fm_def ordinal_fm_def range_fm_def
transset_fm_def subset_fm_def Replace_fm_def
lemmas formulas_def [fm_definitions] = fm_defs
is_iterates_fm_def iterates_MH_fm_def is_wfrec_fm_def is_recfun_fm_def is_transrec_fm_def
is_nat_case_fm_def quasinat_fm_def number1_fm_def ordinal_fm_def finite_ordinal_fm_def
cartprod_fm_def sum_fm_def Inr_fm_def Inl_fm_def
formula_functor_fm_def
Memrel_fm_def transset_fm_def subset_fm_def pre_image_fm_def restriction_fm_def
list_functor_fm_def tl_fm_def quasilist_fm_def Cons_fm_def Nil_fm_def
lemmas sep_rules' [iff_sats] = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
fun_plus_iff_sats omega_iff_sats
lemmas more_iff_sats [iff_sats] = rtran_closure_iff_sats tran_closure_iff_sats
is_eclose_iff_sats Inl_iff_sats Inr_iff_sats fun_apply_iff_sats cartprod_iff_sats
Collect_iff_sats
end v class="head">
Theory Least
sectionâ¹The binder \<^term>â¹Leastâºâº
theory Least
imports
"Internalizations"
begin
textâ¹We have some basic results on the least ordinal satisfying
a predicate.âº
lemma Least_Ord: "(μ α. R(α)) = (μ α. Ord(α) ⧠R(α))"
unfolding Least_def by (simp add:lt_Ord)
lemma Ord_Least_cong:
assumes "ây. Ord(y) â¹ R(y) â· Q(y)"
shows "(μ α. R(α)) = (μ α. Q(α))"
proof -
from assms
have "(μ α. Ord(α) ⧠R(α)) = (μ α. Ord(α) ⧠Q(α))"
by simp
then
show ?thesis using Least_Ord by simp
qed
definition
least :: "[iâo,iâo,i] â o" where
"least(M,Q,i) ⡠ordinal(M,i) ⧠(
(empty(M,i) ⧠(âb[M]. ordinal(M,b) ⶠ¬Q(b)))
⨠(Q(i) ⧠(âb[M]. ordinal(M,b) ⧠bâiⶠ¬Q(b))))"
definition
least_fm :: "[i,i] â i" where
"least_fm(q,i) â¡ And(ordinal_fm(i),
Or(And(empty_fm(i),Forall(Implies(ordinal_fm(0),Neg(q)))),
And(Exists(And(q,Equal(0,succ(i)))),
Forall(Implies(And(ordinal_fm(0),Member(0,succ(i))),Neg(q))))))"
lemma least_fm_type[TC] :"i â nat â¹ qâformula â¹ least_fm(q,i) â formula"
unfolding least_fm_def
by simp
lemmas basic_fm_simps = sats_subset_fm' sats_transset_fm' sats_ordinal_fm'
lemma sats_least_fm :
assumes p_iff_sats:
"âa. a â A â¹ P(a) â· sats(A, p, Cons(a, env))"
shows
"â¦y â nat; env â list(A) ; 0âAâ§
â¹ sats(A, least_fm(p,y), env) â·
least(##A, P, nth(y,env))"
using nth_closed p_iff_sats unfolding least_def least_fm_def
by (simp add:basic_fm_simps)
lemma least_iff_sats [iff_sats]:
assumes is_Q_iff_sats:
"âa. a â A â¹ is_Q(a) â· sats(A, q, Cons(a,env))"
shows
"â¦nth(j,env) = y; j â nat; env â list(A); 0âAâ§
â¹ least(##A, is_Q, y) â· sats(A, least_fm(q,j), env)"
using sats_least_fm [OF is_Q_iff_sats, of j , symmetric]
by simp
lemma least_conj: "aâM â¹ least(##M, λx. xâM ⧠Q(x),a) â· least(##M,Q,a)"
unfolding least_def by simp
context M_trivial
begin
subsectionâ¹Uniqueness, absoluteness and closure under \<^term>â¹Leastâºâº
lemma unique_least:
assumes "M(a)" "M(b)" "least(M,Q,a)" "least(M,Q,b)"
shows "a=b"
proof -
from assms
have "Ord(a)" "Ord(b)"
unfolding least_def
by simp_all
then
consider (le) "aâb" | "a=b" | (ge) "bâa"
using Ord_linear[OF â¹Ord(a)⺠â¹Ord(b)âº] by auto
then
show ?thesis
proof(cases)
case le
then show ?thesis using assms unfolding least_def by auto
next
case ge
then show ?thesis using assms unfolding least_def by auto
qed
qed
lemma least_abs:
assumes "âx. Q(x) â¹ Ord(x) â¹ ây[M]. Q(y) ⧠Ord(y)" "M(a)"
shows "least(M,Q,a) ⷠa = (μ x. Q(x))"
unfolding least_def
proof (cases "âb[M]. Ord(b) ⶠ¬ Q(b)"; intro iffI; simp add:assms)
case True
with assms
have "¬ (âi. Ord(i) ⧠Q(i)) " by blast
then
show "0 =(μ x. Q(x))" using Least_0 by simp
then
show "ordinal(M, μ x. Q(x)) ⧠(empty(M, Least(Q)) ⨠Q(Least(Q)))"
by simp
next
assume "âb[M]. Ord(b) ⧠Q(b)"
then
obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
assume "a = (μ x. Q(x))"
moreover
note â¹M(a)âº
moreover from â¹Q(i)⺠â¹Ord(i)âº
have "Q(μ x. Q(x))" (is ?G)
by (blast intro:LeastI)
moreover
have "(âb[M]. Ord(b) ⧠b â (μ x. Q(x)) ⶠ¬ Q(b))" (is "?H")
using less_LeastE[of Q _ False]
by (auto, drule_tac ltI, simp, blast)
ultimately
show "ordinal(M, μ x. Q(x)) ⧠(empty(M, μ x. Q(x)) ⧠(âb[M]. Ord(b) ⶠ¬ Q(b)) ⨠?G ⧠?H)"
by simp
next
assume 1:"âb[M]. Ord(b) ⧠Q(b)"
then
obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
assume "Ord(a) ⧠(a = 0 ⧠(âb[M]. Ord(b) ⶠ¬ Q(b)) ⨠Q(a) ⧠(âb[M]. Ord(b) ⧠b â a ⶠ¬ Q(b)))"
with 1
have "Ord(a)" "Q(a)" "âb[M]. Ord(b) ⧠b â a ⶠ¬ Q(b)"
by blast+
moreover from this and assms
have "Ord(b) â¹ b â a ⹠¬ Q(b)" for b
by (auto dest:transM)
moreover from this and â¹Ord(a)âº
have "b < a ⹠¬ Q(b)" for b
unfolding lt_def using Ord_in_Ord by blast
ultimately
show "a = (μ x. Q(x))"
using Least_equality by simp
qed
lemma Least_closed:
assumes "âx. Q(x) â¹ Ord(x) â¹ ây[M]. Q(y) ⧠Ord(y)"
shows "M(μ x. Q(x))"
using assms Least_le[of Q] Least_0[of Q]
by (cases "(âi[M]. Ord(i) ⧠Q(i))") (force dest:transM ltD)+
textâ¹Older, easier to apply versions (with a simpler assumption
on \<^term>â¹Qâº).âº
lemma least_abs':
assumes "âx. Q(x) â¹ M(x)" "M(a)"
shows "least(M,Q,a) ⷠa = (μ x. Q(x))"
using assms least_abs[of Q] by auto
lemma Least_closed':
assumes "âx. Q(x) â¹ M(x)"
shows "M(μ x. Q(x))"
using assms Least_closed[of Q] by auto
end
end head>
Theory Higher_Order_Constructs
sectionâ¹Fully relational versions of higher order construct âº
theory Higher_Order_Constructs
imports
Recursion_Thms
Least
begin
syntax
"_sats" :: "[i, i, i] â o" ("(_, _ ⨠_)" [36,36,36] 25)
translations
"(M,env ⨠Ï)" â "CONST sats(M,Ï,env)"
definition
is_If :: "[iâo,o,i,i,i] â o" where
"is_If(M,b,t,f,r) ⡠(b ⶠr=t) ⧠(¬b ⶠr=f)"
lemma (in M_trans) If_abs:
"is_If(M,b,t,f,r) â· r = If(b,t,f)"
by (simp add: is_If_def)
definition
is_If_fm :: "[i,i,i,i] â i" where
"is_If_fm(Ï,t,f,r) â¡ Or(And(Ï,Equal(t,r)),And(Neg(Ï),Equal(f,r)))"
lemma is_If_fm_type [TC]: "Ï â formula â¹ t â nat â¹ f â nat â¹ r â nat â¹
is_If_fm(Ï,t,f,r) â formula"
unfolding is_If_fm_def by auto
lemma sats_is_If_fm:
assumes Qsats: "Q â· A, env ⨠Ï" "env â list(A)"
shows "is_If(##A, Q, nth(t, env), nth(f, env), nth(r, env)) â· A, env ⨠is_If_fm(Ï,t,f,r)"
using assms unfolding is_If_def is_If_fm_def by auto
lemma is_If_fm_iff_sats [iff_sats]:
assumes Qsats: "Q â· A, env ⨠Ï" and
"nth(t, env) = ta" "nth(f, env) = fa" "nth(r, env) = ra"
"t â nat" "f â nat" "r â nat" "env â list(A)"
shows "is_If(##A,Q,ta,fa,ra) â· A, env ⨠is_If_fm(Ï,t,f,r)"
using assms sats_is_If_fm[of Q A Ï env t f r] by simp
lemma arity_is_If_fm [arity]:
"Ï â formula â¹ t â nat â¹ f â nat â¹ r â nat â¹
arity(is_If_fm(Ï, t, f, r)) = arity(Ï) ⪠succ(t) ⪠succ(r) ⪠succ(f)"
unfolding is_If_fm_def
by auto
definition
is_The :: "[iâo,iâo,i] â o" where
"is_The(M,Q,i) â¡ (Q(i) ⧠(âx[M]. Q(x) ⧠(ây[M]. Q(y) ⶠy = x))) â¨
(¬(âx[M]. Q(x) ⧠(ây[M]. Q(y) ⶠy = x))) ⧠empty(M,i) "
lemma (in M_trans) The_abs:
assumes "âx. Q(x) â¹ M(x)" "M(a)"
shows "is_The(M,Q,a) â· a = (THE x. Q(x))"
proof (cases "âx[M]. Q(x) ⧠(ây[M]. Q(y) ⶠy = x)")
case True
with assms
show ?thesis
unfolding is_The_def
by (intro iffI the_equality[symmetric])
(auto, blast intro:theI)
next
case False
with â¹âx. Q(x) â¹ M(x)âº
have " ¬ (âx. Q(x) ⧠(ây. Q(y) ⶠy = x))"
by auto
then
have "The(Q) = 0"
by (intro the_0) auto
with assms and False
show ?thesis
unfolding is_The_def
by auto
qed
definition
is_recursor :: "[iâo,i,[i,i,i]âo,i,i] âo" where
"is_recursor(M,a,is_b,k,r) ⡠is_transrec(M, λn f ntc. is_nat_case(M,a,
λm bmfm.
âfm[M]. fun_apply(M,f,m,fm) ⧠is_b(m,fm,bmfm),n,ntc),k,r)"
lemma (in M_eclose) recursor_abs:
assumes "Ord(k)" and
types: "M(a)" "M(k)" "M(r)" and
b_iff: "âm f bmf. M(m) â¹ M(f) â¹ M(bmf) â¹ is_b(m,f,bmf) â· bmf = b(m,f)" and
b_closed: "âm f bmf. M(m) â¹ M(f) â¹ M(b(m,f))" and
repl: "transrec_replacement(M, λn f ntc. is_nat_case(M, a,
λm bmfm. âfm[M]. fun_apply(M, f, m, fm) ⧠is_b( m, fm, bmfm), n, ntc), k)"
shows
"is_recursor(M,a,is_b,k,r) â· r = recursor(a,b,k)"
unfolding is_recursor_def recursor_def
using assms
apply (rule_tac transrec_abs)
apply (auto simp:relation2_def)
apply (rule nat_case_abs[THEN iffD1, where is_b1="λm bmfm.
âfm[M]. fun_apply(M,_,m,fm) ⧠is_b(m,fm,bmfm)"])
apply (auto simp:relation1_def)
apply (rule nat_case_abs[THEN iffD2, where is_b1="λm bmfm.
âfm[M]. fun_apply(M,_,m,fm) ⧠is_b(m,fm,bmfm)"])
apply (auto simp:relation1_def)
done
definition
is_wfrec_on :: "[i=>o,[i,i,i]=>o,i,i,i, i] => o" where
"is_wfrec_on(M,MH,A,r,a,z) == is_wfrec(M,MH,r,a,z)"
lemma (in M_trancl) trans_wfrec_on_abs:
"[|wf(r); trans(r); relation(r); M(r); M(a); M(z);
wfrec_replacement(M,MH,r); relation2(M,MH,H);
âx[M]. âg[M]. function(g) ⶠM(H(x,g));
r-``{a}âA; a â A|]
==> is_wfrec_on(M,MH,A,r,a,z) â· z=wfrec[A](r,a,H)"
using trans_wfrec_abs wfrec_trans_restr
unfolding is_wfrec_on_def by simp
endbody>
Theory Relativization
sectionâ¹Automatic relativization of terms and formulasâº
textâ¹Relativization of terms and formulas. Relativization of formulas shares relativized terms as
far as possible; assuming that the witnesses for the relativized terms are always unique.âº
theory Relativization
imports
"ZF-Constructible.Datatype_absolute"
Higher_Order_Constructs
keywords
"relativize" :: thy_decl % "ML"
and
"relativize_tm" :: thy_decl % "ML"
and
"reldb_add" :: thy_decl % "ML"
and
"reldb_rem" :: thy_decl % "ML"
and
"relationalize" :: thy_decl % "ML"
and
"rel_closed" :: thy_goal_stmt % "ML"
and
"is_iff_rel" :: thy_goal_stmt % "ML"
and
"univalent" :: thy_goal_stmt % "ML"
and
"absolute"
and
"functional"
and
"relational"
and
"external"
and
"for"
begin
ML_fileâ¹Relativization_Database.mlâº
MLâ¹
structure Absoluteness = Named_Thms
(val name = @{binding "absolut"}
val description = "Theorems of absoulte terms and predicates.")
âº
setupâ¹Absoluteness.setupâº
lemmas relative_abs =
M_trans.empty_abs
M_trans.pair_abs
M_trivial.cartprod_abs
M_trans.union_abs
M_trans.inter_abs
M_trans.setdiff_abs
M_trans.Union_abs
M_trivial.cons_abs
M_trivial.successor_abs
M_trans.Collect_abs
M_trans.Replace_abs
M_trivial.lambda_abs2
M_trans.image_abs
M_trivial.nat_case_abs
M_trivial.omega_abs
M_basic.sum_abs
M_trivial.Inl_abs
M_trivial.Inr_abs
M_basic.converse_abs
M_basic.vimage_abs
M_trans.domain_abs
M_trans.range_abs
M_basic.field_abs
M_basic.composition_abs
M_trans.restriction_abs
M_trans.Inter_abs
M_trivial.bool_of_o_abs
M_trivial.not_abs
M_trivial.and_abs
M_trivial.or_abs
M_trivial.Nil_abs
M_trivial.Cons_abs
M_trivial.list_case_abs
M_trivial.hd_abs
M_trivial.tl_abs
M_trivial.least_abs'
M_eclose.transrec_abs
M_trans.If_abs
M_trans.The_abs
M_eclose.recursor_abs
M_trancl.trans_wfrec_abs
M_trancl.trans_wfrec_on_abs
lemmas datatype_abs =
M_datatypes.list_N_abs
M_datatypes.list_abs
M_datatypes.formula_N_abs
M_datatypes.formula_abs
M_eclose.is_eclose_n_abs
M_eclose.eclose_abs
M_datatypes.length_abs
M_datatypes.nth_abs
M_trivial.Member_abs
M_trivial.Equal_abs
M_trivial.Nand_abs
M_trivial.Forall_abs
M_datatypes.depth_abs
M_datatypes.formula_case_abs
declare relative_abs[absolut]
declare datatype_abs[absolut]
MLâ¹
signature Relativization =
sig
structure Data: GENERIC_DATA
val Rel_add: attribute
val Rel_del: attribute
val add_rel_const : Database.mode -> term -> term -> Data.T -> Data.T
val add_constant : Database.mode -> string -> string -> Proof.context -> Proof.context
val rem_constant : (term -> Data.T -> Data.T) -> string -> Proof.context -> Proof.context
val db: Data.T
val init_db : Data.T -> theory -> theory
val get_db : Proof.context -> Data.T
val relativ_fm: bool -> bool -> term -> Data.T -> (term * (term * term)) list * Proof.context * term list * bool -> term -> term * ((term * (term * term)) list * term list * term list * Proof.context)
val relativ_tm: bool -> bool -> term option -> term -> Data.T -> (term * (term * term)) list * Proof.context -> term -> term * (term * (term * term)) list * Proof.context
val read_new_const : Proof.context -> string -> term
val relativ_tm_frm': bool -> bool -> term -> Data.T -> Proof.context -> term -> term option * term
val relativize_def: bool -> bool -> bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
val relativize_tm: bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
val rel_closed_goal : string -> Position.T -> Proof.context -> Proof.state
val iff_goal : string -> Position.T -> Proof.context -> Proof.state
val univalent_goal : string -> Position.T -> Proof.context -> Proof.state
end
structure Relativization : Relativization = struct
infix 6 &&&
val op &&& = Utils.&&&
infix 6 ***
val op *** = Utils.***
infix 6 @@
val op @@ = Utils.@@
infix 6 ---
val op --- = Utils.---
fun insert_abs2rel ((t, u), db) = ((t, u), Database.insert Database.abs2rel (t, t) db)
fun insert_rel2is ((t, u), db) = Database.insert Database.rel2is (t, u) db
val db = [ (@{const relation}, @{const Relative.is_relation})
, (@{const function}, @{const Relative.is_function})
, (@{const mem}, @{const mem})
, (@{const True}, @{const True})
, (@{const False}, @{const False})
, (@{const Memrel}, @{const membership})
, (@{const trancl}, @{const tran_closure})
, (@{const IFOL.eq(i)}, @{const IFOL.eq(i)})
, (@{const Subset}, @{const Relative.subset})
, (@{const quasinat}, @{const Relative.is_quasinat})
, (@{const apply}, @{const Relative.fun_apply})
, (@{const Upair}, @{const Relative.upair})
]
|> List.foldr (insert_rel2is o insert_abs2rel) Database.empty
|> Database.insert Database.abs2is (@{const Pi}, @{const is_funspace})
fun var_i v = Free (v, @{typ i})
fun var_io v = Free (v, @{typ "i â o"})
val const_name = #1 o dest_Const
val lookup_tm = AList.lookup (op aconv)
val update_tm = AList.update (op aconv)
val join_tm = AList.join (op aconv) (K #1)
val conj_ = Utils.binop @{const "IFOL.conj"}
structure Data = Generic_Data
(
type T = Database.db
val empty = Database.empty
val merge = Database.merge
);
fun init_db db = Context.theory_map (Data.put db)
fun get_db thy = Data.get (Context.Proof thy)
val read_const = Proof_Context.read_const {proper = true, strict = true}
val read_new_const = Proof_Context.read_term_pattern
fun add_rel_const mode c t = Database.insert mode (c, t)
fun get_consts thm =
let val (c_rel, rhs) = Thm.concl_of thm |> Utils.dest_trueprop |>
Utils.dest_iff_tms |>> head_of
in case try Utils.dest_eq_tms rhs of
SOME tm => (c_rel, tm |> #2 |> head_of)
| NONE => (c_rel, rhs |> Utils.dest_mem_tms |> #2 |> head_of)
end
fun add_rule thm rs =
let val (c_rel,c_abs) = get_consts thm
in (add_rel_const Database.abs2rel c_abs c_abs o add_rel_const Database.abs2is c_abs c_rel) rs
end
fun get_mode is_functional relationalising = if relationalising then Database.rel2is else if is_functional then Database.abs2rel else Database.abs2is
fun add_constant mode abs rel thy =
let
val c_abs = read_new_const thy abs
val c_rel = read_new_const thy rel
val db_map = Data.map (Database.insert mode (c_abs, c_rel))
fun add_to_context ctxt' = Context.proof_map db_map ctxt'
fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
in
Local_Theory.target (add_to_theory o add_to_context) thy
end
fun rem_constant rem_op c thy =
let
val c = read_new_const thy c
val db_map = Data.map (rem_op c)
fun add_to_context ctxt' = Context.proof_map db_map ctxt'
fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
in
Local_Theory.target (add_to_theory o add_to_context) thy
end
val del_rel_const = Database.remove_abs
fun del_rule thm = del_rel_const (thm |> get_consts |> #2)
val Rel_add =
Thm.declaration_attribute (fn thm => fn context =>
Data.map (add_rule (Thm.trim_context thm)) context);
val Rel_del =
Thm.declaration_attribute (fn thm => fn context =>
Data.map (del_rule (Thm.trim_context thm)) context);
fun conjs [] = @{term IFOL.True}
| conjs (fs as _ :: _) = foldr1 (uncurry conj_) fs
fun rex p t (Free v) = @{const rex} $ p $ lambda (Free v) t
| rex _ t (Bound _) = t
| rex _ t tm = raise TERM ("rex shouldn't handle this.",[tm,t])
val absolute_rels = [ @{const ZF_Base.mem}
, @{const IFOL.eq(i)}
, @{const Memrel}
, @{const True}
, @{const False}
]
fun close_rel_tm pred tm tm_var rs =
let val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs
val (vars, tms) = split_list (map #2 news) ||> (curry op @) (the_list tm)
val vars = case tm_var of
SOME w => filter (fn v => not (v = w)) vars
| NONE => vars
in fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars (conjs tms)
end
fun relativ_tms __ _ _ rs ctxt [] = ([], rs, ctxt)
| relativ_tms is_functional relationalising pred rel_db rs ctxt (u :: us) =
let val (w_u, rs_u, ctxt_u) = relativ_tm is_functional relationalising NONE pred rel_db (rs, ctxt) u
val (w_us, rs_us, ctxt_us) = relativ_tms is_functional relationalising pred rel_db rs_u ctxt_u us
in (w_u :: w_us, join_tm (rs_u , rs_us), ctxt_us)
end
and
relativ_tm is_functional relationalising mv pred rel_db (rs,ctxt) tm =
let
fun mk_rel_const mv c (args, after) abs_args ctxt =
case Database.lookup (get_mode is_functional relationalising) c rel_db of
SOME p =>
let
val args' = List.filter (not o member (op =) (Utils.frees p)) args
val (v, ctxt1) =
the_default
(Variable.variant_fixes [""] ctxt |>> var_i o hd)
(Utils.map_option (I &&& K ctxt) mv)
val args' =
if c = @{const Sigma} andalso is_functional
then
let
val t = hd args'
val t' = Abs ("uu_", @{typ "i"}, (hd o tl) args' |> incr_boundvars 1)
in
[t, t']
end
else
args'
val arg_list = if after then abs_args @ args' else args' @ abs_args
val r_tm =
if is_functional
then list_comb (p, if p = c then arg_list else pred :: arg_list)
else list_comb (p, if (not o null) args' andalso hd args' = pred then arg_list @ [v] else pred :: arg_list @ [v])
in
if is_functional
then (r_tm, r_tm, ctxt)
else (v, r_tm, ctxt1)
end
| NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
fun relativ_app mv mctxt tm abs_args (Const c) (args, after) rs =
let
val (w_ts, rs_ts, ctxt_ts) = relativ_tms is_functional relationalising pred rel_db rs (the_default ctxt mctxt) args
val (w_tm, r_tm, ctxt_tm) = mk_rel_const mv (Const c) (w_ts, after) abs_args ctxt_ts
val rs_ts' = if is_functional then rs_ts else update_tm (tm, (w_tm, r_tm)) rs_ts
in
(w_tm, rs_ts', ctxt_tm)
end
| relativ_app _ _ _ _ t _ _ =
raise TERM ("Tried to relativize an application with a non-constant in head position",[t])
fun relativ_app_no_dep mv tm c t t' rs =
if loose_bvar1 (t', 0)
then
raise TERM("A dependency was found when trying to relativize", [tm])
else
relativ_app mv NONE tm [] c ([t, incr_boundvars ~1 t'], false) rs
fun relativ_replace mv t body after ctxt' =
let
val (v, b) = Utils.dest_abs body |>> var_i ||> after
val (b', (rs', ctxt'')) =
relativ_fm is_functional relationalising pred rel_db (rs, ctxt', single v, false) b |>> incr_boundvars 1 ||> #1 &&& #4
in
relativ_app mv (SOME ctxt'') tm [lambda v b'] @{const Replace} ([t], false) rs'
end
fun get_abs_body (Abs body) = body
| get_abs_body t = raise TERM ("Term is not Abs", [t])
fun go _ (Var _) = raise TERM ("Var: Is this possible?",[])
| go mv (@{const Replace} $ t $ Abs body) = relativ_replace mv t body I ctxt
| go mv (@{const RepFun} $ t $ Abs body) =
let
val (y, ctxt') = Variable.variant_fixes [""] ctxt |>> var_i o hd
in
relativ_replace mv t body (lambda y o Utils.eq_ y o incr_boundvars 1) ctxt'
end
| go mv (@{const Collect} $ t $ pc) =
let
val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
in
relativ_app mv (SOME ctxt') tm [pc'] @{const Collect} ([t], false) rs'
end
| go mv (@{const Least} $ pc) =
let
val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
in
relativ_app mv (SOME ctxt') tm [pc'] @{const Least} ([], false) rs'
end
| go mv (@{const transrec} $ t $ Abs body) =
let
val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
val (x, b') = Utils.dest_abs body |>> var_i
val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
val p = Utils.eq_ res b |> lambda res
val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
in
relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const transrec} ([t], not is_functional) rs'
end
| go mv (tm as @{const Sigma} $ t $ Abs (_, _, t')) =
relativ_app_no_dep mv tm @{const Sigma} t t' rs
| go mv (tm as @{const Pi} $ t $ Abs (_, _, t')) =
relativ_app_no_dep mv tm @{const Pi} t t' rs
| go mv (tm as @{const bool_of_o} $ t) =
let
val (t', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) t ||> #1 &&& #4
in
relativ_app mv (SOME ctxt') tm [t'] @{const bool_of_o} ([], false) rs'
end
| go mv (tm as @{const If} $ b $ t $ t') =
let
val (br, (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) b ||> #1 &&& #4
in
relativ_app mv (SOME ctxt') tm [br] @{const If} ([t,t'], true) rs'
end
| go mv (@{const The} $ pc) =
let
val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
in
relativ_app mv (SOME ctxt') tm [pc'] @{const The} ([], false) rs'
end
| go mv (@{const recursor} $ t $ Abs body $ t') =
let
val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
val (x, b') = Utils.dest_abs body |>> var_i
val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
val p = Utils.eq_ res b |> lambda res
val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
in
relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x o lambda y] @{const recursor} ([t'], true) rs''
end
| go mv (@{const wfrec} $ t1 $ t2 $ Abs body) =
let
val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
val (x, b') = Utils.dest_abs body |>> var_i
val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
val p = Utils.eq_ res b |> lambda res
val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
in
relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec} ([t1,t2], not is_functional) rs'
end
| go mv (@{const wfrec_on} $ t1 $ t2 $ t3 $ Abs body) =
let
val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
val (x, b') = Utils.dest_abs body |>> var_i
val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
val p = Utils.eq_ res b |> lambda res
val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
in
relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec_on} ([t1,t2,t3], not is_functional) rs'
end
| go mv (@{const Lambda} $ t $ Abs body) =
let
val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
val (x, b) = Utils.dest_abs body |>> var_i
val p = Utils.eq_ res b |> lambda res
val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x], true) p |>> incr_boundvars 2 ||> #1 &&& #4
val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
in
relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x] @{const Lambda} ([], true) rs''
end
| go mv (tm as Const _) = relativ_app mv NONE tm [] tm ([], false) rs
| go mv (tm as _ $ _) = (strip_comb tm ||> I &&& K false |> uncurry (relativ_app mv NONE tm [])) rs
| go _ tm = if is_functional then (tm, rs, ctxt) else (tm, update_tm (tm,(tm,tm)) rs, ctxt)
in case lookup_tm rs tm of
NONE => go mv tm
| SOME (w, _) => (w, rs, ctxt)
end
and
relativ_fm is_functional relationalising pred rel_db (rs, ctxt, vs, is_term) fm =
let
fun relativ_app (ctxt, rs) c args = case Database.lookup (get_mode is_functional relationalising) c rel_db of
SOME p =>
let
val flag = not (exists (curry op aconv c) absolute_rels orelse c = p)
val (args, rs_ts, ctxt') = relativ_tms is_functional relationalising pred rel_db rs ctxt args
val args' = List.filter (not o member (op =) (Utils.frees p)) args
val args'' = if not (null args') andalso hd args' = pred then args' else pred :: args'
val tm = list_comb (p, if flag then args'' else args')
val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs_ts
val (vars, tms) = split_list (map #2 news)
in (tm, (rs_ts, vars, tms, ctxt'))
end
| NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
fun close_fm quantifier (f, (rs, vars, tms, ctxt)) =
let
fun contains_b0 t = loose_bvar1 (t, 0)
fun contains_extra_var t = fold (fn v => fn acc => acc orelse fold_aterms (fn t => fn acc => t = v orelse acc) t false) vs false
fun contains_b0_extra t = contains_b0 t orelse contains_extra_var t
fun chained_frees (_ $ v) t2 = member (op =) (Utils.frees t2) v
| chained_frees t _ = raise TERM ("Malformed term", [t])
val tms_to_close = filter contains_b0_extra tms |> Utils.reachable chained_frees tms
val tms_to_keep = map (incr_boundvars ~1) (tms --- tms_to_close)
val vars_to_close = inter (op =) (map (List.last o #2 o strip_comb) tms_to_close) vars
val vars_to_keep = vars --- vars_to_close
val new_rs =
rs
|> filter (fn (k, (v, rel)) => not (contains_b0_extra k orelse contains_b0_extra v orelse contains_b0_extra rel))
|> map (fn (k, (v, rel)) => (incr_boundvars ~1 k, (incr_boundvars ~1 v, incr_boundvars ~1 rel)))
val f' =
if not is_term andalso not quantifier andalso is_functional
then pred $ Bound 0 :: (map (curry (op $) pred) vs) @ [f]
else [f]
in
(fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars_to_close (conjs (f' @ tms_to_close)),
(new_rs, vars_to_keep, tms_to_keep, ctxt))
end
fun bquant (ctxt, rs) quant conn dom pred =
let val (v,pred') = Utils.dest_abs pred |>> var_i
in
go (ctxt, rs, false) (quant $ (lambda v o incr_boundvars 1) (conn $ (@{const mem} $ v $ dom) $ pred'))
end
and
bind_go (ctxt, rs) const f f' =
let
val (r , (rs1, vars1, tms1, ctxt1)) = go (ctxt, rs, false) f
val (r', (rs2, vars2, tms2, ctxt2)) = go (ctxt1, rs1, false) f'
in
(const $ r $ r', (rs2, vars1 @@ vars2, tms1 @@ tms2, ctxt2))
end
and
relativ_eq_var (ctxt, rs) v t =
let
val (_, rs', ctxt') = relativ_tm is_functional relationalising (SOME v) pred rel_db (rs, ctxt) t
val f = lookup_tm rs' t |> #2 o the
val rs'' = filter (not o (curry (op =) t) o #1) rs'
val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs''
val (vars, tms) = split_list (map #2 news)
in
(f, (rs'', vars, tms, ctxt'))
end
and
relativ_eq (ctxt, rs) t1 t2 =
if is_functional orelse ((is_Free t1 orelse is_Bound t1) andalso (is_Free t2 orelse is_Bound t2)) then
relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
else if is_Free t1 orelse is_Bound t1 then
relativ_eq_var (ctxt, rs) t1 t2
else if is_Free t2 orelse is_Bound t2 then
relativ_eq_var (ctxt, rs) t2 t1
else
relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
and
go (ctxt, rs, _ ) (@{const IFOL.conj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.conj} f f'
| go (ctxt, rs, _ ) (@{const IFOL.disj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.disj} f f'
| go (ctxt, rs, _ ) (@{const IFOL.Not} $ f) = go (ctxt, rs, false) f |>> ((curry op $) @{const IFOL.Not})
| go (ctxt, rs, _ ) (@{const IFOL.iff} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.iff} f f'
| go (ctxt, rs, _ ) (@{const IFOL.imp} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.imp} f f'
| go (ctxt, rs, _ ) (@{const IFOL.All(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rall} $ pred))
| go (ctxt, rs, _ ) (@{const IFOL.Ex(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rex} $ pred))
| go (ctxt, rs, _ ) (@{const Bex} $ f $ Abs p) = bquant (ctxt, rs) @{const Ex(i)} @{const IFOL.conj} f p
| go (ctxt, rs, _ ) (@{const Ball} $ f $ Abs p) = bquant (ctxt, rs) @{const All(i)} @{const IFOL.imp} f p
| go (ctxt, rs, _ ) (@{const rall} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rall} $ pred)
| go (ctxt, rs, _ ) (@{const rex} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rex} $ pred)
| go (ctxt, rs, _ ) (@{const IFOL.eq(i)} $ t1 $ t2) = relativ_eq (ctxt, rs) t1 t2
| go (ctxt, rs, _ ) (Const c) = relativ_app (ctxt, rs) (Const c) []
| go (ctxt, rs, _ ) (tm as _ $ _) = strip_comb tm |> uncurry (relativ_app (ctxt, rs))
| go (ctxt, rs, quantifier) (Abs (v, _, t)) =
let
val new_rs = map (fn (k, (v, rel)) => (incr_boundvars 1 k, (incr_boundvars 1 v, incr_boundvars 1 rel))) rs
in
go (ctxt, new_rs, false) t |> close_fm quantifier |>> lambda (var_i v)
end
| go _ t = raise TERM ("Relativization of formulas cannot handle this case.",[t])
in
go (ctxt, rs, false) fm
end
fun relativ_tm_frm' is_functional relationalising cls_pred db ctxt tm =
let
fun get_bounds (l as Abs _) = op @@ (strip_abs l |>> map (op #1) ||> get_bounds)
| get_bounds (t as _$_) = strip_comb t |> op :: |> map get_bounds |> flat
| get_bounds _ = []
val ty = fastype_of tm
val initial_ctxt = fold Utils.add_to_context (get_bounds tm) ctxt
in
case ty of
@{typ i} =>
let
val (w, rs, _) = relativ_tm is_functional relationalising NONE cls_pred db ([], initial_ctxt) tm
in
if is_functional
then (NONE, w)
else (SOME w, close_rel_tm cls_pred NONE (SOME w) rs)
end
| @{typ o} =>
let
fun close_fm (f, (_, vars, tms, _)) =
fold (fn v => fn t => rex cls_pred (incr_boundvars 1 t) v) vars (conjs (f :: tms))
in
(NONE, relativ_fm is_functional relationalising cls_pred db ([], initial_ctxt, [], false) tm |> close_fm)
end
| ty' => raise TYPE ("We can relativize only terms of types i and o", [ty'], [tm])
end
fun lname ctxt = Local_Theory.full_name ctxt o Binding.name
fun destroy_first_lambdas (Abs (body as (_, ty, _))) =
Utils.dest_abs body ||> destroy_first_lambdas |> (#1 o #2) &&& ((fn v => Free (v, ty)) *** #2) ||> op ::
| destroy_first_lambdas t = (t, [])
fun freeType (Free (_, ty)) = ty
| freeType t = raise TERM ("freeType", [t])
fun relativize_def is_external is_functional relationalising def_name thm_ref pos lthy =
let
val ctxt = lthy
val (vars,tm,ctxt1) = Utils.thm_concl_tm ctxt (thm_ref ^ "_def")
val db' = Data.get (Context.Proof lthy)
val (tm, lambdavars) = tm |> destroy_first_lambdas o #2 o Utils.dest_eq_tms' o Utils.dest_trueprop
val ctxt1 = fold Utils.add_to_context (map Utils.freeName lambdavars) ctxt1
val (cls_pred, ctxt1, vars, lambdavars) =
if (not o null) vars andalso (#2 o #1 o hd) vars = @{typ "i â o"} then
((Thm.term_of o #2 o hd) vars, ctxt1, tl vars, lambdavars)
else if null vars andalso (not o null) lambdavars andalso (freeType o hd) lambdavars = @{typ "i â o"} then
(hd lambdavars, ctxt1, vars, tl lambdavars)
else Variable.variant_fixes ["N"] ctxt1 |>> var_io o hd |> (fn (cls, ctxt) => (cls, ctxt, vars, lambdavars))
val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
o Database.insert Database.rel2is (cls_pred, cls_pred)
val (v,t) = relativ_tm_frm' is_functional relationalising cls_pred db' ctxt1 tm
val t_vars = sort_strings (Term.add_free_names tm [])
val vs' = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
val vs = cls_pred :: map (Thm.term_of o #2) vs' @ lambdavars @ the_list v
val at = List.foldr (uncurry lambda) t vs
val abs_const = read_const lthy (if is_external then thm_ref else lname lthy thm_ref)
fun new_const ctxt' = read_new_const ctxt' def_name
fun db_map ctxt' =
Data.map (add_rel_const (get_mode is_functional relationalising) abs_const (new_const ctxt'))
fun add_to_context ctxt' = Context.proof_map (db_map ctxt') ctxt'
fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map (db_map ctxt')) ctxt'
in
lthy
|> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
|>> (#2 #> (fn (s,t) => (s,[t])))
|> Utils.display "theorem" pos
|> Local_Theory.target (add_to_theory o add_to_context)
end
fun relativize_tm is_functional def_name term pos lthy =
let
val ctxt = lthy
val (cls_pred, ctxt1) = Variable.variant_fixes ["N"] ctxt |>> var_io o hd
val tm = Syntax.read_term ctxt1 term
val db' = Data.get (Context.Proof lthy)
val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
o Database.insert Database.rel2is (cls_pred, cls_pred)
val vs' = Variable.add_frees ctxt1 tm []
val ctxt2 = fold Utils.add_to_context (map #1 vs') ctxt1
val (v,t) = relativ_tm_frm' is_functional false cls_pred db' ctxt2 tm
val vs = cls_pred :: map Free vs' @ the_list v
val at = List.foldr (uncurry lambda) t vs
in
lthy
|> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
|>> (#2 #> (fn (s,t) => (s,[t])))
|> Utils.display "theorem" pos
end
val op $` = curry ((op $) o swap)
infix $`
fun is_free_i (Free (_, @{typ "i"})) = true
| is_free_i _ = false
fun rel_closed_goal target pos lthy =
let
val (_, tm, _) = Utils.thm_concl_tm lthy (target ^ "_rel_def")
val (def, tm) = tm |> Utils.dest_eq_tms'
fun first_lambdas (Abs (body as (_, ty, _))) =
if ty = @{typ "i"}
then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
else Utils.dest_abs body |> first_lambdas o #2
| first_lambdas _ = []
val (def, vars) = Term.strip_comb def ||> filter is_free_i
val vs = vars @ first_lambdas tm
val class = Free ("M", @{typ "i â o"})
val def = fold (op $`) (class :: vs) def
val hyps = map (fn v => class $ v |> Utils.tp) vs
val concl = class $ def
val goal = Logic.list_implies (hyps, Utils.tp concl)
val attribs = @{attributes [intro, simp]}
in
Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
o Local_Theory.note ((Binding.name (target ^ "_rel_closed"), attribs), hd thmss))
[[(goal, [])]] lthy
end
fun iff_goal target pos lthy =
let
val (_, tm, ctxt') = Utils.thm_concl_tm lthy (target ^ "_rel_def")
val (_, is_def, ctxt) = Utils.thm_concl_tm ctxt' ("is_" ^ target ^ "_def")
val is_def = is_def |> Utils.dest_eq_tms' |> #1 |> Term.strip_comb |> #1
val (def, tm) = tm |> Utils.dest_eq_tms'
fun first_lambdas (Abs (body as (_, ty, _))) =
if ty = @{typ "i"}
then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
else Utils.dest_abs body |> first_lambdas o #2
| first_lambdas _ = []
val (def, vars) = Term.strip_comb def ||> filter is_free_i
val vs = vars @ first_lambdas tm
val class = Free ("M", @{typ "i â o"})
val def = fold (op $`) (class :: vs) def
val ty = fastype_of def
val res = if ty = @{typ "i"}
then Variable.variant_fixes ["res"] ctxt |> SOME o Utils.var_i o hd o #1
else NONE
val is_def = fold (op $`) (class :: vs @ the_list res) is_def
val hyps = map (fn v => class $ v |> Utils.tp) (vs @ the_list res)
val concl = @{const "IFOL.iff"} $ is_def
$ (if ty = @{typ "i"} then (@{const IFOL.eq(i)} $ the res $ def) else def)
val goal = Logic.list_implies (hyps, Utils.tp concl)
in
Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
o Local_Theory.note ((Binding.name ("is_" ^ target ^ "_iff"), []), hd thmss))
[[(goal, [])]] lthy
end
fun univalent_goal target pos lthy =
let
val (_, tm, ctxt) = Utils.thm_concl_tm lthy ("is_" ^ target ^ "_def")
val (def, tm) = tm |> Utils.dest_eq_tms'
fun first_lambdas (Abs (body as (_, ty, _))) =
if ty = @{typ "i"}
then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
else Utils.dest_abs body |> first_lambdas o #2
| first_lambdas _ = []
val (def, vars) = Term.strip_comb def ||> filter is_free_i
val vs = vars @ first_lambdas tm
val n = length vs
val vs = List.take (vs, n - 2)
val class = Free ("M", @{typ "i â o"})
val def = fold (op $`) (class :: vs) def
val v = Variable.variant_fixes ["A"] ctxt |> Utils.var_i o hd o #1
val hyps = map (fn v => class $ v |> Utils.tp) (v :: vs)
val concl = @{const "Relative.univalent"} $ class $ v $ def
val goal = Logic.list_implies (hyps, Utils.tp concl)
in
Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
o Local_Theory.note ((Binding.name ("univalent_is_" ^ target), []), hd thmss))
[[(goal, [])]] lthy
end
end
âº
MLâ¹
local
val full_mode_parser =
Scan.option (((Parse.$$$ "functional" |-- Parse.$$$ "relational") >> K Database.rel2is)
|| (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "functional") >> K Database.abs2rel)
|| (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "relational") >> K Database.abs2is))
>> (fn mode => the_default Database.abs2is mode)
val reldb_parser =
Parse.position (full_mode_parser -- (Parse.string -- Parse.string));
val singlemode_parser = (Parse.$$$ "absolute" >> K Database.remove_abs)
|| (Parse.$$$ "functional" >> K Database.remove_rel)
|| (Parse.$$$ "relational" >> K Database.remove_is)
val reldb_rem_parser = Parse.position (singlemode_parser -- Parse.string)
val mode_parser =
Scan.option ((Parse.$$$ "relational" >> K false) || (Parse.$$$ "functional" >> K true))
>> (fn mode => if is_none mode then false else the mode)
val relativize_parser =
Parse.position (mode_parser -- (Parse.string -- Parse.string) -- (Scan.optional (Parse.$$$ "external" >> K true) false));
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹reldb_add⺠"ML setup for adding relativized/absolute pairs"
(reldb_parser >> (fn ((mode, (abs_term,rel_term)),_) =>
Relativization.add_constant mode abs_term rel_term))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹reldb_rem⺠"ML setup for adding relativized/absolute pairs"
(reldb_rem_parser >> (uncurry Relativization.rem_constant o #1))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹relativize⺠"ML setup for relativizing definitions"
(relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
Relativization.relativize_def is_external is_functional false thm bndg pos))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹relativize_tm⺠"ML setup for relativizing definitions"
(relativize_parser >> (fn (((is_functional, (bndg,term)), _),pos) =>
Relativization.relativize_tm is_functional term bndg pos))
val _ =
Outer_Syntax.local_theory \<^command_keyword>â¹relationalize⺠"ML setup for relativizing definitions"
(relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
Relativization.relativize_def is_external is_functional true thm bndg pos))
val _ =
Outer_Syntax.local_theory_to_proof \<^command_keyword>â¹rel_closed⺠"ML setup for rel_closed theorem"
(Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
Relativization.rel_closed_goal target pos))
val _ =
Outer_Syntax.local_theory_to_proof \<^command_keyword>â¹is_iff_rel⺠"ML setup for rel_closed theorem"
(Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
Relativization.iff_goal target pos))
val _ =
Outer_Syntax.local_theory_to_proof \<^command_keyword>â¹univalent⺠"ML setup for rel_closed theorem"
(Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
Relativization.univalent_goal target pos))
val _ =
Theory.setup
(Attrib.setup \<^binding>â¹Rel⺠(Attrib.add_del Relativization.Rel_add Relativization.Rel_del)
"declaration of relativization rule") ;
in
end
âº
setupâ¹Relativization.init_db Relativization.db âº
declare relative_abs[Rel]
declare datatype_abs[Rel]
MLâ¹
val db = Relativization.get_db @{context}
âº
end
tle>
File â¹Relativization_Database.mlâº
signature Database =
sig
type db
val empty : db
type mode
val abs2is : mode
val abs2rel : mode
val rel2is : mode
val lookup : mode -> term -> db -> term option
val insert : mode -> term * term -> db -> db
val remove_abs : term -> db -> db
val remove_rel : term -> db -> db
val remove_is : term -> db -> db
val merge : db * db -> db
end
structure Database : Database = struct
type db = { ar : (term * term) list
, af : (term * term) list
, fr : (term * term) list
}
val empty = { ar = []
, af = []
, fr = []
}
datatype singlemode = Absolute | Relational | Functional
type mode = singlemode * singlemode
val abs2is = (Absolute, Relational)
val abs2rel = (Absolute, Functional)
val rel2is = (Functional, Relational)
infix 6 &&&
val op &&& = Utils.&&&
infix 5 |||
fun op ||| (x, y) = fn t =>
case x t of
SOME a => SOME a
| NONE => y t
infix 5 >>=
fun op >>= (m, f) =
case m of
SOME x => f x
| NONE => NONE
infix 6 COMP
fun op COMP (xs, ys) = fn t => AList.lookup (op aconv) ys t >>= AList.lookup (op aconv) xs
val transpose = map (#2 &&& #1)
fun lookup (Absolute, Relational) t db = (#fr db COMP #af db ||| AList.lookup (op aconv) (#ar db)) t
| lookup (Absolute, Functional) t db = AList.lookup (op aconv) (#af db) t
| lookup (Functional, Relational) t db = AList.lookup (op aconv) (#fr db) t
| lookup (Relational, Absolute) t db = (transpose (#af db) COMP transpose (#fr db) ||| AList.lookup (op aconv) (transpose (#ar db))) t
| lookup (Functional, Absolute) t db = AList.lookup (op aconv) (transpose (#af db)) t
| lookup (Relational, Functional) t db = AList.lookup (op aconv) (transpose (#fr db)) t
| lookup _ _ _ = error "lookup: unreachable clause"
fun insert' warn (mode as (Absolute, Relational)) (t, u) db =
(case lookup mode t db of
SOME _ => (warn ("insert abs2is: duplicate entry for " ^ (@{make_string} t)); db)
| NONE => case lookup (Relational, Functional) u db of
SOME v => if is_none (lookup (Functional, Absolute) v db)
then { ar = #ar db
, af = AList.update (op aconv) (t, v) (#af db)
, fr = #fr db
}
else error "invariant violation, insert abs2is"
| NONE => case lookup (Absolute, Functional) t db of
SOME v => { ar = #ar db
, af = #af db
, fr = AList.update (op aconv) (v, u) (#fr db)
}
| NONE => { ar = AList.update (op aconv) (t, u) (#ar db)
, af = #af db
, fr = #fr db
}
)
| insert' warn (mode as (Absolute, Functional)) (t, v) db =
(case lookup mode t db of
SOME _ => (warn ("insert abs2rel: duplicate entry for " ^ (@{make_string} t)); db)
| NONE => case lookup (Functional, Relational) v db of
SOME u => (case lookup (Relational, Absolute) u db of
NONE => { ar = #ar db
, af = AList.update (op aconv) (t, v) (#af db)
, fr = #fr db
}
| SOME t' => if t = t'
then { ar = AList.delete (op aconv) t (#ar db)
, af = AList.update (op aconv) (t, v) (#af db)
, fr = #fr db
}
else error "invariant violation, insert abs2rel"
)
| NONE => case lookup (Absolute, Relational) t db of
SOME u => { ar = AList.delete (op aconv) t (#ar db)
, af = AList.update (op aconv) (t, v) (#af db)
, fr = AList.update (op aconv) (v, u) (#fr db)
}
| NONE => { ar = #ar db
, af = AList.update (op aconv) (t, v) (#af db)
, fr = #fr db
}
)
| insert' warn (mode as (Functional, Relational)) (v, u) db =
(case lookup mode v db of
SOME _ => (warn ("insert rel2is: duplicate entry for " ^ (@{make_string} v)); db)
| NONE => case (lookup (Functional, Absolute) v db, lookup (Relational, Absolute) u db) of
(SOME t, SOME t') => if t = t'
then { ar = AList.delete (op aconv) t (#ar db)
, af = #af db
, fr = AList.update (op aconv) (v, u) (#fr db)
}
else error ("invariant violation, insert rel2is: " ^ (@{make_string} (v, u, t, t')))
| (SOME _, NONE) => { ar = #ar db
, af = #af db
, fr = AList.update (op aconv) (v, u) (#fr db)
}
| (NONE, SOME t') => { ar = AList.delete (op aconv) t' (#ar db)
, af = AList.update (op aconv) (t', v) (#af db)
, fr = AList.update (op aconv) (v, u) (#fr db)
}
| (NONE, NONE) => { ar = #ar db
, af = #af db
, fr = AList.update (op aconv) (v, u) (#fr db)
}
)
| insert' _ _ _ _ = error "insert: unreachable clause"
val insert = insert' warning
fun remove Absolute t db = { ar = AList.delete (op aconv) t (#ar db)
, af = AList.delete (op aconv) t (#af db)
, fr = #fr db
}
| remove Functional v db =
(case lookup (Functional, Absolute) v db of
SOME t => (case lookup (Functional, Relational) v db of
SOME u => { ar = AList.update (op aconv) (t, u) (#ar db)
, af = transpose (AList.delete (op aconv) v (transpose (#af db)))
, fr = AList.delete (op aconv) v (#fr db)
}
| NONE => { ar = #ar db
, af = transpose (AList.delete (op aconv) v (transpose (#af db)))
, fr = #fr db
}
)
| NONE => { ar = #ar db
, af = #af db
, fr = AList.delete (op aconv) v (#fr db)
}
)
| remove Relational u db = { ar = transpose (AList.delete (op aconv) u (transpose (#ar db)))
, af = #af db
, fr = transpose (AList.delete (op aconv) u (transpose (#fr db)))
}
val remove_abs = remove Absolute
val remove_rel = remove Functional
val remove_is = remove Relational
fun merge (db, db') =
let
val modes = [(abs2rel, #af db'), (rel2is, #fr db'), (abs2is, #ar db)]
in
List.foldr (fn ((m, db'), db) => List.foldr (uncurry (insert' (K ()) m)) db db') db modes
end
end
Theory Discipline_Base
theory Discipline_Base
imports
"ZF-Constructible.Rank"
ZF_Miscellanea
M_Basic_No_Repl
Relativization
begin
declare [[syntax_ambiguity_warning = false]]
subsectionâ¹Discipline of relativization of basic conceptsâº
definition
is_singleton :: "[iâo,i,i] â o" where
"is_singleton(A,x,z) â¡ âc[A]. empty(A,c) ⧠is_cons(A,x,c,z)"
lemma (in M_trivial) singleton_abs[simp] :
"⦠M(x) ; M(s) ⧠⹠is_singleton(M,x,s) ⷠs = {x}"
unfolding is_singleton_def using nonempty by simp
synthesize "singleton" from_definition "is_singleton"
notation singleton_fm (â¹â
{_} is _â
âº)
lemma (in M_trivial) singleton_closed [simp]:
"M(x) â¹ M({x})"
by simp
lemma (in M_trivial) Upair_closed[simp]: "M(a) â¹ M(b) â¹ M(Upair(a,b))"
using Upair_eq_cons by simp
textâ¹The following named theorems gather instances of transitivity
that arise from closure theoremsâº
named_theorems trans_closed
definition
is_hcomp :: "[iâo,iâiâo,iâiâo,i,i] â o" where
"is_hcomp(M,is_f,is_g,a,w) â¡ âz[M]. is_g(a,z) ⧠is_f(z,w)"
lemma (in M_trivial) is_hcomp_abs:
assumes
is_f_abs:"âa z. M(a) â¹ M(z) â¹ is_f(a,z) â· z = f(a)" and
is_g_abs:"âa z. M(a) â¹ M(z) â¹ is_g(a,z) â· z = g(a)" and
g_closed:"âa. M(a) â¹ M(g(a))"
"M(a)" "M(w)"
shows
"is_hcomp(M,is_f,is_g,a,w) â· w = f(g(a))"
unfolding is_hcomp_def using assms by simp
definition
hcomp_fm :: "[iâiâi,iâiâi,i,i] â i" where
"hcomp_fm(pf,pg,a,w) â¡ Exists(And(pg(succ(a),0),pf(0,succ(w))))"
lemma sats_hcomp_fm:
assumes
f_iff_sats:"âa b z. aânat â¹ bânat â¹ zâM â¹
is_f(nth(a,Cons(z,env)),nth(b,Cons(z,env))) â· sats(M,pf(a,b),Cons(z,env))"
and
g_iff_sats:"âa b z. aânat â¹ bânat â¹ zâM â¹
is_g(nth(a,Cons(z,env)),nth(b,Cons(z,env))) â· sats(M,pg(a,b),Cons(z,env))"
and
"aânat" "wânat" "envâlist(M)"
shows
"sats(M,hcomp_fm(pf,pg,a,w),env) â· is_hcomp(##M,is_f,is_g,nth(a,env),nth(w,env))"
proof -
have "sats(M, pf(0, succ(w)), Cons(x, env)) â· is_f(x,nth(w,env))" if "xâM" "wânat" for x w
using f_iff_sats[of 0 "succ(w)" x] that by simp
moreover
have "sats(M, pg(succ(a), 0), Cons(x, env)) â· is_g(nth(a,env),x)" if "xâM" "aânat" for x a
using g_iff_sats[of "succ(a)" 0 x] that by simp
ultimately
show ?thesis unfolding hcomp_fm_def is_hcomp_def using assms by simp
qed
definition
hcomp_r :: "[iâo,[iâo,i,i]âo,[iâo,i,i]âo,i,i] â o" where
"hcomp_r(M,is_f,is_g,a,w) â¡ âz[M]. is_g(M,a,z) ⧠is_f(M,z,w)"
definition
is_hcomp2_2 :: "[iâo,[iâo,i,i,i]âo,[iâo,i,i,i]âo,[iâo,i,i,i]âo,i,i,i] â o" where
"is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) â¡ âg1ab[M]. âg2ab[M].
is_g1(M,a,b,g1ab) ⧠is_g2(M,a,b,g2ab) ⧠is_f(M,g1ab,g2ab,w)"
lemma (in M_trivial) hcomp_abs:
assumes
is_f_abs:"âa z. M(a) â¹ M(z) â¹ is_f(M,a,z) â· z = f(a)" and
is_g_abs:"âa z. M(a) â¹ M(z) â¹ is_g(M,a,z) â· z = g(a)" and
g_closed:"âa. M(a) â¹ M(g(a))"
"M(a)" "M(w)"
shows
"hcomp_r(M,is_f,is_g,a,w) â· w = f(g(a))"
unfolding hcomp_r_def using assms by simp
lemma hcomp_uniqueness:
assumes
uniq_is_f:
"âr d d'. M(r) â¹ M(d) â¹ M(d') â¹ is_f(M, r, d) â¹ is_f(M, r, d') â¹
d = d'"
and
uniq_is_g:
"âr d d'. M(r) â¹ M(d) â¹ M(d') â¹ is_g(M, r, d) â¹ is_g(M, r, d') â¹
d = d'"
and
"M(a)" "M(w)" "M(w')"
"hcomp_r(M,is_f,is_g,a,w)"
"hcomp_r(M,is_f,is_g,a,w')"
shows
"w=w'"
proof -
from assms
obtain z z' where "is_g(M, a, z)" "is_g(M, a, z')"
"is_f(M,z,w)" "is_f(M,z',w')"
"M(z)" "M(z')"
unfolding hcomp_r_def by blast
moreover from this and uniq_is_g and â¹M(a)âº
have "z=z'" by blast
moreover note uniq_is_f and â¹M(w)⺠â¹M(w')âº
ultimately
show ?thesis by blast
qed
lemma hcomp_witness:
assumes
wit_is_f: "âr. M(r) â¹ âd[M]. is_f(M,r,d)" and
wit_is_g: "âr. M(r) â¹ âd[M]. is_g(M,r,d)" and
"M(a)"
shows
"âw[M]. hcomp_r(M,is_f,is_g,a,w)"
proof -
from â¹M(a)⺠and wit_is_g
obtain z where "is_g(M,a,z)" "M(z)" by blast
moreover from this and wit_is_f
obtain w where "is_f(M,z,w)" "M(w)" by blast
ultimately
show ?thesis
using assms unfolding hcomp_r_def by auto
qed
lemma (in M_trivial) hcomp2_2_abs:
assumes
is_f_abs:"âr1 r2 z. M(r1) â¹ M(r2) â¹ M(z) â¹ is_f(M,r1,r2,z) â· z = f(r1,r2)" and
is_g1_abs:"âr1 r2 z. M(r1) â¹ M(r2) â¹ M(z) â¹ is_g1(M,r1,r2,z) â· z = g1(r1,r2)" and
is_g2_abs:"âr1 r2 z. M(r1) â¹ M(r2) â¹ M(z) â¹ is_g2(M,r1,r2,z) â· z = g2(r1,r2)" and
types: "M(a)" "M(b)" "M(w)" "M(g1(a,b))" "M(g2(a,b))"
shows
"is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) â· w = f(g1(a,b),g2(a,b))"
unfolding is_hcomp2_2_def using assms
by simp
lemma hcomp2_2_uniqueness:
assumes
uniq_is_f:
"âr1 r2 d d'. M(r1) â¹ M(r2) â¹ M(d) â¹ M(d') â¹
is_f(M, r1, r2 , d) â¹ is_f(M, r1, r2, d') â¹ d = d'"
and
uniq_is_g1:
"âr1 r2 d d'. M(r1) â¹ M(r2)â¹ M(d) â¹ M(d') â¹ is_g1(M, r1,r2, d) â¹ is_g1(M, r1,r2, d') â¹
d = d'"
and
uniq_is_g2:
"âr1 r2 d d'. M(r1) â¹ M(r2)â¹ M(d) â¹ M(d') â¹ is_g2(M, r1,r2, d) â¹ is_g2(M, r1,r2, d') â¹
d = d'"
and
"M(a)" "M(b)" "M(w)" "M(w')"
"is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
"is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w')"
shows
"w=w'"
proof -
from assms
obtain z z' y y' where "is_g1(M, a,b, z)" "is_g1(M, a,b, z')"
"is_g2(M, a,b, y)" "is_g2(M, a,b, y')"
"is_f(M,z,y,w)" "is_f(M,z',y',w')"
"M(z)" "M(z')" "M(y)" "M(y')"
unfolding is_hcomp2_2_def by force
moreover from this and uniq_is_g1 uniq_is_g2 and â¹M(a)⺠â¹M(b)âº
have "z=z'" "y=y'" by blast+
moreover note uniq_is_f and â¹M(w)⺠â¹M(w')âº
ultimately
show ?thesis by blast
qed
lemma hcomp2_2_witness:
assumes
wit_is_f: "âr1 r2. M(r1) â¹ M(r2) â¹ âd[M]. is_f(M,r1,r2,d)" and
wit_is_g1: "âr1 r2. M(r1) â¹ M(r2) â¹ âd[M]. is_g1(M,r1,r2,d)" and
wit_is_g2: "âr1 r2. M(r1) â¹ M(r2) â¹ âd[M]. is_g2(M,r1,r2,d)" and
"M(a)" "M(b)"
shows
"âw[M]. is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
proof -
from â¹M(a)⺠â¹M(b)⺠and wit_is_g1
obtain g1a where "is_g1(M,a,b,g1a)" "M(g1a)" by blast
moreover from â¹M(a)⺠â¹M(b)⺠and wit_is_g2
obtain g2a where "is_g2(M,a,b,g2a)" "M(g2a)" by blast
moreover from calculation and wit_is_f
obtain w where "is_f(M,g1a,g2a,w)" "M(w)" by blast
ultimately
show ?thesis
using assms unfolding is_hcomp2_2_def by auto
qed
lemma (in M_trivial) extensionality_trans:
assumes
"M(d) ⧠(âx[M]. xâd â· P(x))"
"M(d') ⧠(âx[M]. xâd' â· P(x))"
shows
"d=d'"
proof -
from assms
have "âx. xâd â· P(x) ⧠M(x)"
using transM[of _ d] by auto
moreover from assms
have "âx. xâd' â· P(x) ⧠M(x)"
using transM[of _ d'] by auto
ultimately
show ?thesis by auto
qed
definition
lt_rel :: "[iâo,i,i] â o" where
"lt_rel(M,a,b) â¡ aâb ⧠ordinal(M,b)"
lemma (in M_trans) lt_abs[absolut]: "M(a) â¹ M(b) â¹ lt_rel(M,a,b) â· a<b"
unfolding lt_rel_def lt_def by auto
definition
le_rel :: "[iâo,i,i] â o" where
"le_rel(M,a,b) â¡ âsb[M]. successor(M,b,sb) ⧠lt_rel(M,a,sb)"
lemma (in M_trivial) le_abs[absolut]: "M(a) â¹ M(b) â¹ le_rel(M,a,b) â· aâ¤b"
unfolding le_rel_def by (simp add:absolut)
subsectionâ¹Discipline for \<^term>â¹Powâºâº
definition
is_Pow :: "[iâo,i,i] â o" where
"is_Pow(M,A,z) â¡ M(z) ⧠(âx[M]. x â z â· subset(M,x,A))"
definition
Pow_rel :: "[iâo,i] â i" (â¹Powâ_â'(_')âº) where
"Pow_rel(M,r) â¡ THE d. is_Pow(M,r,d)"
abbreviation
Pow_r_set :: "[i,i] â i" (â¹Powâ_â'(_')âº) where
"Pow_r_set(M) â¡ Pow_rel(##M)"
context M_basic_no_repl
begin
lemma is_Pow_uniqueness:
assumes
"M(r)"
"is_Pow(M,r,d)" "is_Pow(M,r,d')"
shows
"d=d'"
using assms extensionality_trans
unfolding is_Pow_def
by simp
lemma is_Pow_witness: "M(r) â¹ âd[M]. is_Pow(M,r,d)"
using power_ax unfolding power_ax_def powerset_def is_Pow_def
by simp
lemma is_Pow_closed : "⦠M(r);is_Pow(M,r,d) ⧠⹠M(d)"
unfolding is_Pow_def by simp
lemma Pow_rel_closed[intro,simp]: "M(r) â¹ M(Pow_rel(M,r))"
unfolding Pow_rel_def
using is_Pow_closed theI[OF ex1I[of "λd. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
is_Pow_witness
by fastforce
lemmas trans_Pow_rel_closed[trans_closed] = transM[OF _ Pow_rel_closed]
textâ¹The proof of \<^term>â¹f_rel_iff⺠lemma is schematic and it can reused by copy-paste
replacing appropriately.âº
lemma Pow_rel_iff:
assumes "M(r)" "M(d)"
shows "is_Pow(M,r,d) â· d = Pow_rel(M,r)"
proof (intro iffI)
assume "d = Pow_rel(M,r)"
with assms
show "is_Pow(M, r, d)"
using is_Pow_uniqueness[of r] is_Pow_witness
theI[OF ex1I[of "λd. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
unfolding Pow_rel_def
by auto
next
assume "is_Pow(M, r, d)"
with assms
show "d = Pow_rel(M,r)"
using is_Pow_uniqueness unfolding Pow_rel_def
by (auto del:the_equality intro:the_equality[symmetric])
qed
textâ¹The next "def\_" result really corresponds to @{thm Pow_iff}âº
lemma def_Pow_rel: "M(A) â¹ M(r) â¹ AâPow_rel(M,r) â· A â r"
using Pow_rel_iff[OF _ Pow_rel_closed, of r r]
unfolding is_Pow_def by simp
lemma Pow_rel_char: "M(r) â¹ Pow_rel(M,r) = {AâPow(r). M(A)}"
proof -
assume "M(r)"
moreover from this
have "x â Pow_rel(M,r) â¹ xâr" "M(x) â¹ x â r â¹ x â Pow_rel(M,r)" for x
using def_Pow_rel by (auto intro!:trans_Pow_rel_closed)
ultimately
show ?thesis
using trans_Pow_rel_closed by blast
qed
lemma mem_Pow_rel_abs: "M(a) â¹ M(r) â¹ a â Pow_rel(M,r) â· a â Pow(r)"
using Pow_rel_char by simp
end
subsectionâ¹Discipline for \<^term>â¹PiPâºâº
definition
PiP_rel:: "[iâo,i,i]âo" where
"PiP_rel(M,A,f) â¡ âdf[M]. is_domain(M,f,df) ⧠subset(M,A,df) â§
is_function(M,f)"
context M_basic
begin
lemma def_PiP_rel:
assumes
"M(A)" "M(f)"
shows
"PiP_rel(M,A,f) â· A â domain(f) ⧠function(f)"
using assms unfolding PiP_rel_def by simp
end
definition
Sigfun :: "[i,iâi]âi" where
"Sigfun(x,B) â¡ âyâB(x). {â¨x,yâ©}"
lemma Sigma_Sigfun: "Sigma(A,B) = â {Sigfun(x,B) . xâA}"
unfolding Sigma_def Sigfun_def ..
definition
is_Sigfun :: "[iâo,i,iâi,i]âo" where
"is_Sigfun(M,x,B,Sd) â¡ M(Sd) ⧠(âRB[M]. is_Replace(M,B(x),λy z. z={â¨x,yâ©},RB)
⧠big_union(M,RB,Sd))"
context M_trivial
begin
lemma is_Sigfun_abs:
assumes
"strong_replacement(M,λy z. z={â¨x,yâ©})"
"M(x)" "M(B(x))" "M(Sd)"
shows
"is_Sigfun(M,x,B,Sd) â· Sd = Sigfun(x,B)"
proof -
have "â{z . y â B(x), z = {â¨x, yâ©}} = (âyâB(x). {â¨x, yâ©})" by auto
then
show ?thesis
using assms transM[OF _ â¹M(B(x))âº] Replace_abs
unfolding is_Sigfun_def Sigfun_def by auto
qed
lemma Sigfun_closed:
assumes
"strong_replacement(M, λy z. y â B(x) ⧠z = {â¨x, yâ©})"
"M(x)" "M(B(x))"
shows
"M(Sigfun(x,B))"
using assms transM[OF _ â¹M(B(x))âº] RepFun_closed2
unfolding Sigfun_def by simp
lemmas trans_Sigfun_closed[trans_closed] = transM[OF _ Sigfun_closed]
end
definition
is_Sigma :: "[iâo,i,iâi,i]âo" where
"is_Sigma(M,A,B,S) â¡ M(S) ⧠(âRSf[M].
is_Replace(M,A,λx z. z=Sigfun(x,B),RSf) ⧠big_union(M,RSf,S))"
locale M_Pi = M_basic +
assumes
Pi_separation: "M(A) â¹ separation(M, PiP_rel(M,A))"
and
Pi_replacement:
"M(x) â¹ M(y) â¹
strong_replacement(M, λya z. ya â y ⧠z = {â¨x, yaâ©})"
"M(y) â¹
strong_replacement(M, λx z. z = (âxaây. {â¨x, xaâ©}))"
locale M_Pi_assumptions = M_Pi +
fixes A B
assumes
Pi_assumptions:
"M(A)"
"âx. xâA â¹ M(B(x))"
"âxâA. strong_replacement(M, λy z. y â B(x) ⧠z = {â¨x, yâ©})"
"strong_replacement(M,λx z. z=Sigfun(x,B))"
begin
lemma Sigma_abs[simp]:
assumes
"M(S)"
shows
"is_Sigma(M,A,B,S) â· S = Sigma(A,B)"
proof -
have "â{z . x â A, z = Sigfun(x, B)} = (âxâA. Sigfun(x, B))"
by auto
with assms
show ?thesis
using Replace_abs[of A _ "λx z. z=Sigfun(x,B)"]
Sigfun_closed Sigma_Sigfun[of A B] transM[of _ A]
Pi_assumptions is_Sigfun_abs
unfolding is_Sigma_def by simp
qed
lemma Sigma_closed[intro,simp]: "M(Sigma(A,B))"
proof -
have "(âxâA. Sigfun(x, B)) = â{z . x â A, z = Sigfun(x, B)}"
by auto
then
show ?thesis
using Sigma_Sigfun[of A B] transM[of _ A]
Sigfun_closed Pi_assumptions
by simp
qed
lemmas trans_Sigma_closed[trans_closed] = transM[OF _ Sigma_closed]
end
subsectionâ¹Discipline for \<^term>â¹Piâºâº
definition
is_Pi :: "[iâo,i,iâi,i]âo" where
"is_Pi(M,A,B,I) â¡ M(I) ⧠(âS[M]. âPS[M]. is_Sigma(M,A,B,S) â§
is_Pow(M,S,PS) â§
is_Collect(M,PS,PiP_rel(M,A),I))"
definition
Pi_rel :: "[iâo,i,iâi] â i" (â¹Piâ_â'(_,_')âº) where
"Pi_rel(M,A,B) â¡ THE d. is_Pi(M,A,B,d)"
abbreviation
Pi_r_set :: "[i,i,iâi] â i" (â¹Piâ_â'(_,_')âº) where
"Pi_r_set(M,A,B) â¡ Pi_rel(##M,A,B)"
context M_basic
begin
lemmas Pow_rel_iff = mbnr.Pow_rel_iff
lemmas Pow_rel_char = mbnr.Pow_rel_char
lemmas mem_Pow_rel_abs = mbnr.mem_Pow_rel_abs
lemmas Pow_rel_closed = mbnr.Pow_rel_closed
lemmas def_Pow_rel = mbnr.def_Pow_rel
lemmas trans_Pow_rel_closed = mbnr.trans_Pow_rel_closed
end
context M_Pi_assumptions
begin
lemma is_Pi_uniqueness:
assumes
"is_Pi(M,A,B,d)" "is_Pi(M,A,B,d')"
shows
"d=d'"
using assms Pi_assumptions extensionality_trans
Pow_rel_iff
unfolding is_Pi_def by simp
lemma is_Pi_witness: "âd[M]. is_Pi(M,A,B,d)"
using Pow_rel_iff Pi_separation Pi_assumptions
unfolding is_Pi_def by simp
lemma is_Pi_closed : "is_Pi(M,A,B,d) â¹ M(d)"
unfolding is_Pi_def by simp
lemma Pi_rel_closed[intro,simp]: "M(Pi_rel(M,A,B))"
proof -
have "is_Pi(M, A, B, THE xa. is_Pi(M, A, B, xa))"
using Pi_assumptions
theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness]
is_Pi_witness is_Pi_closed
by auto
then show ?thesis
using is_Pi_closed
unfolding Pi_rel_def
by simp
qed
lemmas trans_Pi_rel_closed[trans_closed] = transM[OF _ Pi_rel_closed]
lemma Pi_rel_iff:
assumes "M(d)"
shows "is_Pi(M,A,B,d) â· d = Pi_rel(M,A,B)"
proof (intro iffI)
assume "d = Pi_rel(M,A,B)"
moreover
note assms
moreover from this
obtain e where "M(e)" "is_Pi(M,A,B,e)"
using is_Pi_witness by blast
ultimately
show "is_Pi(M, A, B, d)"
using is_Pi_uniqueness is_Pi_witness is_Pi_closed
theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness, of e]
unfolding Pi_rel_def
by simp
next
assume "is_Pi(M, A, B, d)"
with assms
show "d = Pi_rel(M,A,B)"
using is_Pi_uniqueness is_Pi_closed unfolding Pi_rel_def
by (blast del:the_equality intro:the_equality[symmetric])
qed
lemma def_Pi_rel:
"Pi_rel(M,A,B) = {fâPow_rel(M,Sigma(A,B)). Aâdomain(f) ⧠function(f)}"
proof -
have "Pi_rel(M,A, B) â Pow_rel(M,Sigma(A,B))"
using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"] Pow_rel_iff
unfolding is_Pi_def by auto
moreover
have "f â Pi_rel(M,A, B) â¹ Aâdomain(f) ⧠function(f)" for f
using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"]
def_PiP_rel[of A f] trans_closed Pow_rel_iff
unfolding is_Pi_def by simp
moreover
have "f â Pow_rel(M,Sigma(A,B)) â¹ Aâdomain(f) ⧠function(f) â¹ f â Pi_rel(M,A, B)" for f
using Pi_rel_iff[of "Pi_rel(M,A,B)"] Pi_assumptions
def_PiP_rel[of A f] trans_closed Pow_rel_iff
unfolding is_Pi_def by simp
ultimately
show ?thesis by force
qed
lemma Pi_rel_char: "Pi_rel(M,A,B) = {fâPi(A,B). M(f)}"
using Pi_assumptions def_Pi_rel Pow_rel_char[OF Sigma_closed] unfolding Pi_def
by fastforce
lemma mem_Pi_rel_abs:
assumes "M(f)"
shows "f â Pi_rel(M,A,B) â· f â Pi(A,B)"
using assms Pi_rel_char by simp
end
textâ¹The next locale (and similar ones below) are used to
show the relationship between versions of simple (i.e.
$\Sigma_1^{\mathit{ZF}}$, $\Pi_1^{\mathit{ZF}}$) concepts in two
different transitive models.âº
locale M_N_Pi_assumptions = M:M_Pi_assumptions + N:M_Pi_assumptions N for N +
assumes
M_imp_N:"M(x) â¹ N(x)"
begin
lemma Pi_rel_transfer: "PiâMâ(A,B) â PiâNâ(A,B)"
using M.Pi_rel_char N.Pi_rel_char M_imp_N by auto
end
locale M_Pi_assumptions_0 = M_Pi_assumptions _ 0
begin
textâ¹This is used in the proof of \<^term>â¹AC_Pi_relâºâº
lemma Pi_rel_empty1[simp]: "PiâMâ(0,B) = {0}"
using Pi_assumptions Pow_rel_char
by (unfold def_Pi_rel function_def) (auto)
end
context M_Pi_assumptions
begin
subsectionâ¹Auxiliary ported results on \<^term>â¹Pi_relâº, now unusedâº
lemma Pi_rel_iff':
assumes types:"M(f)"
shows
"f â Pi_rel(M,A,B) â· function(f) ⧠f â Sigma(A,B) ⧠A â domain(f)"
using assms Pow_rel_char
by (simp add:def_Pi_rel, blast)
lemma lam_type_M:
assumes "M(A)" "âx. xâA â¹ M(B(x))"
"âx. x â A â¹ b(x)âB(x)" "strong_replacement(M,λx y. y=â¨x, b(x)â©) "
shows "(λxâA. b(x)) â Pi_rel(M,A,B)"
proof (auto simp add: lam_def def_Pi_rel function_def)
from assms
have "M({â¨x, b(x)â© . x â A})"
using Pi_assumptions transM[OF _ â¹M(A)âº]
by (rule_tac RepFun_closed, auto intro!:transM[OF _ â¹âx. xâA â¹ M(B(x))âº])
with assms
show "{â¨x, b(x)â© . x â A} â PowâMâ(Sigma(A, B))"
using Pow_rel_char by auto
qed
end
locale M_Pi_assumptions2 = M_Pi_assumptions +
PiC: M_Pi_assumptions _ _ C for C
begin
lemma Pi_rel_type:
assumes "f â PiâMâ(A,C)" "âx. x â A â¹ f`x â B(x)"
and types: "M(f)"
shows "f â PiâMâ(A,B)"
using assms Pi_assumptions
by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
(blast dest: function_apply_equality)
lemma Pi_rel_weaken_type:
assumes "f â PiâMâ(A,B)" "âx. x â A â¹ B(x) â C(x)"
and types: "M(f)"
shows "f â PiâMâ(A,C)"
using assms Pi_assumptions
by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
(blast intro: Pi_rel_type dest: apply_type)
end
end div class="head">
Theory Arities
sectionâ¹Arities of internalized formulasâº
theory Arities
imports
Discipline_Base
begin
lemmas FOL_arities [simp del, arity] = arity_And arity_Or arity_Implies arity_Iff arity_Exists
declare pred_Un_distrib[arity_aux]
context
notes FOL_arities[simp]
begin
lemma arity_upair_fm [arity] : "⦠t1ânat ; t2ânat ; upânat ⧠â¹
arity(upair_fm(t1,t2,up)) = â {succ(t1),succ(t2),succ(up)}"
unfolding upair_fm_def
using union_abs1 union_abs2 pred_Un
by auto
end
lemma Un_trasposition_aux1: "r ⪠s ⪠r = r ⪠s" by auto
lemma Un_trasposition_aux2:
"r ⪠(s ⪠(r ⪠u))= r ⪠(s ⪠u)"
"r ⪠(s ⪠(t ⪠(r ⪠u)))= r ⪠(s ⪠(t ⪠u))" by auto
txtâ¹Using the previous lemmas to guide the automatic arity calculation.âº
context
notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
begin
arity_theorem for "pair_fm"
arity_theorem for "composition_fm"
arity_theorem for "domain_fm"
arity_theorem for "range_fm"
arity_theorem for "union_fm"
arity_theorem for "image_fm"
arity_theorem for "pre_image_fm"
arity_theorem for "big_union_fm"
arity_theorem for "fun_apply_fm"
arity_theorem for "field_fm"
arity_theorem for "empty_fm"
arity_theorem for "cons_fm"
arity_theorem for "succ_fm"
arity_theorem for "number1_fm"
arity_theorem for "function_fm"
arity_theorem for "relation_fm"
arity_theorem for "restriction_fm"
arity_theorem for "typed_function_fm"
arity_theorem for "subset_fm"
arity_theorem for "transset_fm"
arity_theorem for "ordinal_fm"
arity_theorem for "limit_ordinal_fm"
arity_theorem for "finite_ordinal_fm"
arity_theorem for "omega_fm"
arity_theorem for "cartprod_fm"
arity_theorem for "singleton_fm"
arity_theorem for "Memrel_fm"
arity_theorem for "quasinat_fm"
end
context
notes FOL_arities[simp]
begin
lemma arity_is_recfun_fm [arity]:
"â¦pâformula ; vânat ; nânat; Zânat;iânat⧠⹠arity(p) = i â¹
arity(is_recfun_fm(p,v,n,Z)) = succ(v) ⪠succ(n) ⪠succ(Z) ⪠pred(pred(pred(pred(i))))"
unfolding is_recfun_fm_def
using arity_upair_fm arity_pair_fm arity_pre_image_fm arity_restriction_fm
union_abs2 pred_Un_distrib
by auto
lemma arity_is_wfrec_fm [arity]:
"â¦pâformula ; vânat ; nânat; Zânat ; iânat⧠⹠arity(p) = i â¹
arity(is_wfrec_fm(p,v,n,Z)) = succ(v) ⪠succ(n) ⪠succ(Z) ⪠pred(pred(pred(pred(pred(i)))))"
unfolding is_wfrec_fm_def
using arity_succ_fm arity_is_recfun_fm
union_abs2 pred_Un_distrib
by auto
lemma arity_is_nat_case_fm [arity]:
"â¦pâformula ; vânat ; nânat; Zânat; iânat⧠⹠arity(p) = i â¹
arity(is_nat_case_fm(v,p,n,Z)) = succ(v) ⪠succ(n) ⪠succ(Z) ⪠pred(pred(i))"
unfolding is_nat_case_fm_def
using arity_succ_fm arity_empty_fm arity_quasinat_fm
union_abs2 pred_Un_distrib
by auto
lemma arity_iterates_MH_fm [arity]:
assumes "isFâformula" "vânat" "nânat" "gânat" "zânat" "iânat"
"arity(isF) = i"
shows "arity(iterates_MH_fm(isF,v,n,g,z)) =
succ(v) ⪠succ(n) ⪠succ(g) ⪠succ(z) ⪠pred(pred(pred(pred(i))))"
proof -
let ?Ï = "Exists(And(fun_apply_fm(succ(succ(succ(g))), 2, 0), Forall(Implies(Equal(0, 2), isF))))"
let ?ar = "succ(succ(succ(g))) ⪠pred(pred(i))"
from assms
have "arity(?Ï) =?ar" "?Ïâformula"
using arity_fun_apply_fm
union_abs1 union_abs2 pred_Un_distrib succ_Un_distrib Un_assoc[symmetric]
by simp_all
then
show ?thesis
unfolding iterates_MH_fm_def
using arity_is_nat_case_fm[OF â¹?Ïâ_⺠_ _ _ _ â¹arity(?Ï) = ?arâº] assms pred_succ_eq pred_Un_distrib
by auto
qed
lemma arity_is_iterates_fm [arity]:
assumes "pâformula" "vânat" "nânat" "Zânat" "iânat"
"arity(p) = i"
shows "arity(is_iterates_fm(p,v,n,Z)) = succ(v) ⪠succ(n) ⪠succ(Z) âª
pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))))"
proof -
let ?Ï = "iterates_MH_fm(p, 7+â©Ïv, 2, 1, 0)"
let ?Ï = "is_wfrec_fm(?Ï, 0, succ(succ(n)),succ(succ(Z)))"
from â¹vâ_âº
have "arity(?Ï) = (8+â©Ïv) ⪠pred(pred(pred(pred(i))))" "?Ïâformula"
using assms arity_iterates_MH_fm union_abs2
by simp_all
then
have "arity(?Ï) = succ(succ(succ(n))) ⪠succ(succ(succ(Z))) ⪠(3+â©Ïv) âª
pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))"
using assms arity_is_wfrec_fm[OF â¹?Ïâ_⺠_ _ _ _ â¹arity(?Ï) = _âº] union_abs1 pred_Un_distrib
by auto
then
show ?thesis
unfolding is_iterates_fm_def
using arity_Memrel_fm arity_succ_fm assms union_abs1 pred_Un_distrib
by auto
qed
lemma arity_eclose_n_fm [arity]:
assumes "Aânat" "xânat" "tânat"
shows "arity(eclose_n_fm(A,x,t)) = succ(A) ⪠succ(x) ⪠succ(t)"
proof -
let ?Ï = "big_union_fm(1,0)"
have "arity(?Ï) = 2" "?Ïâformula"
using arity_big_union_fm union_abs2
by auto
with assms
show ?thesis
unfolding eclose_n_fm_def
using arity_is_iterates_fm[OF â¹?Ïâ_⺠_ _ _,of _ _ _ 2]
by auto
qed
lemma arity_mem_eclose_fm [arity]:
assumes "xânat" "tânat"
shows "arity(mem_eclose_fm(x,t)) = succ(x) ⪠succ(t)"
proof -
let ?Ï="eclose_n_fm(x +â©Ï 2, 1, 0)"
from â¹xânatâº
have "arity(?Ï) = x+â©Ï3"
using arity_eclose_n_fm union_abs2
by simp
with assms
show ?thesis
unfolding mem_eclose_fm_def
using arity_finite_ordinal_fm union_abs2 pred_Un_distrib
by simp
qed
lemma arity_is_eclose_fm [arity]:
"â¦xânat ; tânat⧠⹠arity(is_eclose_fm(x,t)) = succ(x) ⪠succ(t)"
unfolding is_eclose_fm_def
using arity_mem_eclose_fm union_abs2 pred_Un_distrib
by auto
lemma arity_Collect_fm [arity]:
assumes "x â nat" "y â nat" "pâformula"
shows "arity(Collect_fm(x,p,y)) = succ(x) ⪠succ(y) ⪠pred(arity(p))"
unfolding Collect_fm_def
using assms pred_Un_distrib
by auto
schematic_goal arity_least_fm':
assumes
"i â nat" "q â formula"
shows
"arity(least_fm(q,i)) â¡ ?ar"
unfolding least_fm_def
using assms pred_Un_distrib arity_And arity_Or arity_Neg arity_Implies arity_ordinal_fm
arity_empty_fm Un_assoc[symmetric] Un_commute
by auto
lemma arity_least_fm [arity]:
assumes
"i â nat" "q â formula"
shows
"arity(least_fm(q,i)) = succ(i) ⪠pred(arity(q))"
using assms arity_least_fm'
by auto
lemma arity_Replace_fm [arity]:
"â¦pâformula ; vânat ; nânat; iânat⧠⹠arity(p) = i â¹
arity(Replace_fm(v,p,n)) = succ(n) ⪠succ(v) ⪠pred(pred(i))"
unfolding Replace_fm_def
using union_abs2 pred_Un_distrib
by auto
lemma arity_lambda_fm [arity]:
"â¦pâformula; vânat ; nânat; iânat⧠⹠arity(p) = i â¹
arity(lambda_fm(p,v,n)) = succ(n) ⪠(succ(v) ⪠(pred^3(i)))"
unfolding lambda_fm_def
using arity_pair_fm pred_Un_distrib union_abs1 union_abs2
by simp
lemma arity_transrec_fm [arity]:
"â¦pâformula ; vânat ; nânat; iânat⧠⹠arity(p) = i â¹
arity(is_transrec_fm(p,v,n)) = succ(v) ⪠succ(n) ⪠(pred^8(i))"
unfolding is_transrec_fm_def
using arity Un_assoc[symmetric] pred_Un_distrib
by simp
lemma arity_wfrec_replacement_fm :
"â¦pâformula ; vânat ; nânat; Zânat ; iânat⧠⹠arity(p) = i â¹
arity(Exists(And(pair_fm(1,0,2),is_wfrec_fm(p,v,n,Z))))
= 2 ⪠v ⪠n ⪠Z ⪠(pred^6(i))"
unfolding is_wfrec_fm_def
using arity_succ_fm arity_is_recfun_fm union_abs2 pred_Un_distrib arity_pair_fm
by auto
end
declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
context
notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
begin
arity_theorem for "rtran_closure_mem_fm"
arity_theorem for "rtran_closure_fm"
arity_theorem for "tran_closure_fm"
end
context
notes Un_assoc[simp] Un_trasposition_aux2[simp]
begin
arity_theorem for "injection_fm"
arity_theorem for "surjection_fm"
arity_theorem for "bijection_fm"
arity_theorem for "order_isomorphism_fm"
end
arity_theorem for "Inl_fm"
arity_theorem for "Inr_fm"
arity_theorem for "pred_set_fm"
end>
Theory Discipline_Function
theory Discipline_Function
imports
Arities
begin
paragraphâ¹Discipline for \<^term>â¹fstâºâº
arity_theorem for "empty_fm"
arity_theorem for "upair_fm"
arity_theorem for "pair_fm"
definition
is_fst :: "(iâo)âiâiâo" where
"is_fst(M,x,t) â¡ (âz[M]. pair(M,t,z,x)) â¨
(¬(âz[M]. âw[M]. pair(M,w,z,x)) ⧠empty(M,t))"
synthesize "fst" from_definition "is_fst"
notation fst_fm (â¹â
fst'(_') is _â
âº)
arity_theorem for "fst_fm"
definition fst_rel :: "[iâo,i] â i" where
"fst_rel(M,p) ⡠THE d. M(d) ⧠is_fst(M,p,d)"
reldb_add relational "fst" "is_fst"
reldb_add functional "fst" "fst_rel"
definition
is_snd :: "(iâo)âiâiâo" where
"is_snd(M,x,t) â¡ (âz[M]. pair(M,z,t,x)) â¨
(¬(âz[M]. âw[M]. pair(M,z,w,x)) ⧠empty(M,t))"
synthesize "snd" from_definition "is_snd"
notation snd_fm (â¹â
snd'(_') is _â
âº)
arity_theorem for "snd_fm"
definition snd_rel :: "[iâo,i] â i" where
"snd_rel(M,p) ⡠THE d. M(d) ⧠is_snd(M,p,d)"
reldb_add relational "snd" "is_snd"
reldb_add functional "snd" "snd_rel"
context M_trans
begin
lemma fst_snd_closed:
assumes "M(p)"
shows "M(fst(p)) ⧠M(snd(p))"
unfolding fst_def snd_def using assms
by (cases "âa. âb. p = â¨a, bâ©";auto)
lemma fst_closed[intro,simp]: "M(x) â¹ M(fst(x))"
using fst_snd_closed by auto
lemma snd_closed[intro,simp]: "M(x) â¹ M(snd(x))"
using fst_snd_closed by auto
lemma fst_abs [absolut]:
"â¦M(p); M(x) ⧠⹠is_fst(M,p,x) â· x = fst(p)"
unfolding is_fst_def fst_def
by (cases "âa. âb. p = â¨a, bâ©";auto)
lemma snd_abs [absolut]:
"â¦M(p); M(y) ⧠⹠is_snd(M,p,y) â· y = snd(p)"
unfolding is_snd_def snd_def
by (cases "âa. âb. p = â¨a, bâ©";auto)
lemma empty_rel_abs : "M(x) ⹠M(0) ⹠x = 0 ⷠx = (THE d. M(d) ⧠empty(M, d))"
unfolding the_def
using transM
by auto
lemma fst_rel_abs:
assumes "M(p)"
shows "fst(p) = fst_rel(M,p)"
using fst_abs assms
unfolding fst_def fst_rel_def
by (cases "âa. âb. p = â¨a, bâ©";auto;rule_tac the_equality[symmetric],simp_all)
lemma snd_rel_abs:
assumes "M(p)"
shows "snd(p) = snd_rel(M,p)"
using snd_abs assms
unfolding snd_def snd_rel_def
by (cases "âa. âb. p = â¨a, bâ©";auto;rule_tac the_equality[symmetric],simp_all)
end
relativize functional "first" "first_rel" external
relativize functional "minimum" "minimum_rel" external
context M_trans
begin
lemma minimum_closed[simp,intro]:
assumes "M(A)"
shows "M(minimum(r,A))"
using first_is_elem the_equality_if transM[OF _ â¹M(A)âº]
by(cases "âx . first(x,A,r)",auto simp:minimum_def)
lemma first_abs :
assumes "M(B)"
shows "first(z,B,r) â· first_rel(M,z,B,r)"
unfolding first_def first_rel_def using assms by auto
lemma minimum_abs:
assumes "M(B)"
shows "minimum(r,B) = minimum_rel(M,r,B)"
proof -
from assms
have "first(b, B, r) ⷠM(b) ⧠first_rel(M,b,B,r)" for b
using first_abs
proof (auto)
fix b
assume "first_rel(M,b,B,r)"
with â¹M(B)âº
have "bâB" using first_abs first_is_elem by simp
with â¹M(B)âº
show "M(b)" using transM[OF â¹bâBâº] by simp
qed
with assms
show ?thesis unfolding minimum_rel_def minimum_def
by simp
qed
end
subsectionâ¹Discipline for \<^term>â¹function_spaceâºâº
definition
is_function_space :: "[iâo,i,i,i] â o" where
"is_function_space(M,A,B,fs) ⡠M(fs) ⧠is_funspace(M,A,B,fs)"
definition
function_space_rel :: "[iâo,i,i] â i" where
"function_space_rel(M,A,B) â¡ THE d. is_function_space(M,A,B,d)"
reldb_rem absolute "Pi"
reldb_add relational "Pi" "is_function_space"
reldb_add functional "Pi" "function_space_rel"
abbreviation
function_space_r :: "[i,iâo,i] â i" (â¹_ ââ_â _⺠[61,1,61] 60) where
"A ââMâ B â¡ function_space_rel(M,A,B)"
abbreviation
function_space_r_set :: "[i,i,i] â i" (â¹_ ââ_â _⺠[61,1,61] 60) where
"function_space_r_set(A,M) â¡ function_space_rel(##M,A)"
context M_Pi
begin
lemma is_function_space_uniqueness:
assumes
"M(r)" "M(B)"
"is_function_space(M,r,B,d)" "is_function_space(M,r,B,d')"
shows
"d=d'"
using assms extensionality_trans
unfolding is_function_space_def is_funspace_def
by simp
lemma is_function_space_witness:
assumes "M(A)" "M(B)"
shows "âd[M]. is_function_space(M,A,B,d)"
proof -
from assms
interpret M_Pi_assumptions M A "λ_. B"
using Pi_replacement Pi_separation
by unfold_locales (auto dest:transM simp add:Sigfun_def)
have "âf[M]. f â Pi_rel(M,A, λ_. B) â· f â A â B"
using Pi_rel_char by simp
with assms
show ?thesis unfolding is_funspace_def is_function_space_def by auto
qed
lemma is_function_space_closed :
"is_function_space(M,A,B,d) â¹ M(d)"
unfolding is_function_space_def by simp
lemma function_space_rel_closed[intro,simp]:
assumes "M(x)" "M(y)"
shows "M(function_space_rel(M,x,y))"
proof -
have "is_function_space(M, x, y, THE xa. is_function_space(M, x, y, xa))"
using assms
theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y]]
is_function_space_witness
by auto
then show ?thesis
using assms is_function_space_closed
unfolding function_space_rel_def
by blast
qed
lemmas trans_function_space_rel_closed[trans_closed] = transM[OF _ function_space_rel_closed]
lemma is_function_space_iff:
assumes "M(x)" "M(y)" "M(d)"
shows "is_function_space(M,x,y,d) â· d = function_space_rel(M,x,y)"
proof (intro iffI)
assume "d = function_space_rel(M,x,y)"
moreover
note assms
moreover from this
obtain e where "M(e)" "is_function_space(M,x,y,e)"
using is_function_space_witness by blast
ultimately
show "is_function_space(M, x, y, d)"
using is_function_space_uniqueness[of x y] is_function_space_witness
theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y], of e]
unfolding function_space_rel_def
by auto
next
assume "is_function_space(M, x, y, d)"
with assms
show "d = function_space_rel(M,x,y)"
using is_function_space_uniqueness unfolding function_space_rel_def
by (blast del:the_equality intro:the_equality[symmetric])
qed
lemma def_function_space_rel:
assumes "M(A)" "M(y)"
shows "function_space_rel(M,A,y) = Pi_rel(M,A,λ_. y)"
proof -
from assms
interpret M_Pi_assumptions M A "λ_. y"
using Pi_replacement Pi_separation
by unfold_locales (auto dest:transM simp add:Sigfun_def)
from assms
have "xâfunction_space_rel(M,A,y) â· xâPi_rel(M,A,λ_. y)" if "M(x)" for x
using that
is_function_space_iff[of A y, OF _ _ function_space_rel_closed, of A y]
def_Pi_rel Pi_rel_char mbnr.Pow_rel_char
unfolding is_function_space_def is_funspace_def by (simp add:Pi_def)
with assms
show ?thesis
using transM[OF _ function_space_rel_closed, OF _ â¹M(A)⺠â¹M(y)âº]
transM[OF _ Pi_rel_closed] by blast
qed
lemma function_space_rel_char:
assumes "M(A)" "M(y)"
shows "function_space_rel(M,A,y) = {f â A â y. M(f)}"
proof -
from assms
interpret M_Pi_assumptions M A "λ_. y"
using Pi_replacement Pi_separation
by unfold_locales (auto dest:transM simp add:Sigfun_def)
show ?thesis
using assms def_function_space_rel Pi_rel_char
by simp
qed
lemma mem_function_space_rel_abs:
assumes "M(A)" "M(y)" "M(f)"
shows "f â function_space_rel(M,A,y) â· f â A â y"
using assms function_space_rel_char by simp
end
locale M_N_Pi = M:M_Pi + N:M_Pi N for N +
assumes
M_imp_N:"M(x) â¹ N(x)"
begin
lemma function_space_rel_transfer: "M(A) â¹ M(B) â¹
function_space_rel(M,A,B) â function_space_rel(N,A,B)"
using M.function_space_rel_char N.function_space_rel_char
by (auto dest!:M_imp_N)
end
abbreviation
"is_apply â¡ fun_apply"
subsectionâ¹Discipline for \<^term>â¹Collect⺠terms.âº
textâ¹We have to isolate the predicate involved and apply the
Discipline to it.âº
definition
injP_rel:: "[iâo,i,i]âo" where
"injP_rel(M,A,f) â¡ âw[M]. âx[M]. âfw[M]. âfx[M]. wâA ⧠xâA â§
is_apply(M,f,w,fw) ⧠is_apply(M,f,x,fx) ⧠fw=fxⶠw=x"
synthesize "injP_rel" from_definition assuming "nonempty"
arity_theorem for "injP_rel_fm"
context M_basic
begin
lemma def_injP_rel:
assumes
"M(A)" "M(f)"
shows
"injP_rel(M,A,f) â· (âw[M]. âx[M]. wâA ⧠xâA ⧠f`w=f`x ⶠw=x)"
using assms unfolding injP_rel_def by simp
end
subsectionâ¹Discipline for \<^term>â¹injâºâº
definition
is_inj :: "[iâo,i,i,i]âo" where
"is_inj(M,A,B,I) â¡ M(I) ⧠(âF[M]. is_function_space(M,A,B,F) â§
is_Collect(M,F,injP_rel(M,A),I))"
declare typed_function_iff_sats Collect_iff_sats [iff_sats]
synthesize "is_funspace" from_definition assuming "nonempty"
arity_theorem for "is_funspace_fm"
synthesize "is_function_space" from_definition assuming "nonempty"
notation is_function_space_fm (â¹â
_ â _ is _â
âº)
arity_theorem for "is_function_space_fm"
synthesize "is_inj" from_definition assuming "nonempty"
notation is_inj_fm (â¹â
inj'(_,_') is _â
âº)
arity_theorem intermediate for "is_inj_fm"
lemma arity_is_inj_fm[arity]:
"A â nat â¹
B â nat â¹ I â nat â¹ arity(is_inj_fm(A, B, I)) = succ(A) ⪠succ(B) ⪠succ(I)"
using arity_is_inj_fm' by (auto simp:pred_Un_distrib arity)
definition
inj_rel :: "[iâo,i,i] â i" (â¹injâ_â'(_,_')âº) where
"inj_rel(M,A,B) â¡ THE d. is_inj(M,A,B,d)"
abbreviation
inj_r_set :: "[i,i,i] â i" (â¹injâ_â'(_,_')âº) where
"inj_r_set(M) â¡ inj_rel(##M)"
locale M_inj = M_Pi +
assumes
injP_separation: "M(r) â¹ separation(M,injP_rel(M, r))"
begin
lemma is_inj_uniqueness:
assumes
"M(r)" "M(B)"
"is_inj(M,r,B,d)" "is_inj(M,r,B,d')"
shows
"d=d'"
using assms is_function_space_iff extensionality_trans
unfolding is_inj_def by simp
lemma is_inj_witness: "M(r) â¹ M(B)â¹ âd[M]. is_inj(M,r,B,d)"
using injP_separation is_function_space_iff
unfolding is_inj_def by simp
lemma is_inj_closed :
"is_inj(M,x,y,d) â¹ M(d)"
unfolding is_inj_def by simp
lemma inj_rel_closed[intro,simp]:
assumes "M(x)" "M(y)"
shows "M(inj_rel(M,x,y))"
proof -
have "is_inj(M, x, y, THE xa. is_inj(M, x, y, xa))"
using assms
theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y]]
is_inj_witness
by auto
then show ?thesis
using assms is_inj_closed
unfolding inj_rel_def
by blast
qed
lemmas trans_inj_rel_closed[trans_closed] = transM[OF _ inj_rel_closed]
lemma inj_rel_iff:
assumes "M(x)" "M(y)" "M(d)"
shows "is_inj(M,x,y,d) â· d = inj_rel(M,x,y)"
proof (intro iffI)
assume "d = inj_rel(M,x,y)"
moreover
note assms
moreover from this
obtain e where "M(e)" "is_inj(M,x,y,e)"
using is_inj_witness by blast
ultimately
show "is_inj(M, x, y, d)"
using is_inj_uniqueness[of x y] is_inj_witness
theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y], of e]
unfolding inj_rel_def
by auto
next
assume "is_inj(M, x, y, d)"
with assms
show "d = inj_rel(M,x,y)"
using is_inj_uniqueness unfolding inj_rel_def
by (blast del:the_equality intro:the_equality[symmetric])
qed
lemma def_inj_rel:
assumes "M(A)" "M(B)"
shows "inj_rel(M,A,B) =
{f â function_space_rel(M,A,B). âw[M]. âx[M]. wâA ⧠xâA ⧠f`w = f`x ⶠw=x}"
(is "_ = Collect(_,?P)")
proof -
from assms
have "inj_rel(M,A,B) â function_space_rel(M,A,B)"
using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
unfolding is_inj_def by auto
moreover from assms
have "f â inj_rel(M,A,B) â¹ ?P(f)" for f
using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
def_injP_rel transM[OF _ function_space_rel_closed, OF _ â¹M(A)⺠â¹M(B)âº]
unfolding is_inj_def by auto
moreover from assms
have "f â function_space_rel(M,A,B) â¹ ?P(f) â¹ f â inj_rel(M,A,B)" for f
using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
def_injP_rel transM[OF _ function_space_rel_closed, OF _ â¹M(A)⺠â¹M(B)âº]
unfolding is_inj_def by auto
ultimately
show ?thesis by force
qed
lemma inj_rel_char:
assumes "M(A)" "M(B)"
shows "inj_rel(M,A,B) = {f â inj(A,B). M(f)}"
proof -
from assms
interpret M_Pi_assumptions M A "λ_. B"
using Pi_replacement Pi_separation
by unfold_locales (auto dest:transM simp add:Sigfun_def)
from assms
show ?thesis
using def_inj_rel[OF assms] def_function_space_rel[OF assms]
transM[OF _ â¹M(A)âº] Pi_rel_char
unfolding inj_def
by auto
qed
end
locale M_N_inj = M:M_inj + N:M_inj N for N +
assumes
M_imp_N:"M(x) â¹ N(x)"
begin
lemma inj_rel_transfer: "M(A) â¹ M(B) â¹ inj_rel(M,A,B) â inj_rel(N,A,B)"
using M.inj_rel_char N.inj_rel_char
by (auto dest!:M_imp_N)
end
definition
surjP_rel:: "[iâo,i,i,i]âo" where
"surjP_rel(M,A,B,f) â¡
ây[M]. âx[M]. âfx[M]. yâB ⶠxâA ⧠is_apply(M,f,x,fx) ⧠fx=y"
synthesize "surjP_rel" from_definition assuming "nonempty"
context M_basic
begin
lemma def_surjP_rel:
assumes
"M(A)" "M(B)" "M(f)"
shows
"surjP_rel(M,A,B,f) â· (ây[M]. âx[M]. yâB ⶠxâA ⧠f`x=y)"
using assms unfolding surjP_rel_def by auto
end
subsectionâ¹Discipline for \<^term>â¹surjâºâº
definition
is_surj :: "[iâo,i,i,i]âo" where
"is_surj(M,A,B,I) â¡ M(I) ⧠(âF[M]. is_function_space(M,A,B,F) â§
is_Collect(M,F,surjP_rel(M,A,B),I))"
synthesize "is_surj" from_definition assuming "nonempty"
notation is_surj_fm (â¹â
surj'(_,_') is _â
âº)
definition
surj_rel :: "[iâo,i,i] â i" (â¹surjâ_â'(_,_')âº) where
"surj_rel(M,A,B) â¡ THE d. is_surj(M,A,B,d)"
abbreviation
surj_r_set :: "[i,i,i] â i" (â¹surjâ_â'(_,_')âº) where
"surj_r_set(M) â¡ surj_rel(##M)"
locale M_surj = M_Pi +
assumes
surjP_separation: "M(A)â¹M(B)â¹separation(M,λx. surjP_rel(M,A,B,x))"
begin
lemma is_surj_uniqueness:
assumes
"M(r)" "M(B)"
"is_surj(M,r,B,d)" "is_surj(M,r,B,d')"
shows
"d=d'"
using assms is_function_space_iff extensionality_trans
unfolding is_surj_def by simp
lemma is_surj_witness: "M(r) â¹ M(B)â¹ âd[M]. is_surj(M,r,B,d)"
using surjP_separation is_function_space_iff
unfolding is_surj_def by simp
lemma is_surj_closed :
"is_surj(M,x,y,d) â¹ M(d)"
unfolding is_surj_def by simp
lemma surj_rel_closed[intro,simp]:
assumes "M(x)" "M(y)"
shows "M(surj_rel(M,x,y))"
proof -
have "is_surj(M, x, y, THE xa. is_surj(M, x, y, xa))"
using assms
theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y]]
is_surj_witness
by auto
then show ?thesis
using assms is_surj_closed
unfolding surj_rel_def
by blast
qed
lemmas trans_surj_rel_closed[trans_closed] = transM[OF _ surj_rel_closed]
lemma surj_rel_iff:
assumes "M(x)" "M(y)" "M(d)"
shows "is_surj(M,x,y,d) â· d = surj_rel(M,x,y)"
proof (intro iffI)
assume "d = surj_rel(M,x,y)"
moreover
note assms
moreover from this
obtain e where "M(e)" "is_surj(M,x,y,e)"
using is_surj_witness by blast
ultimately
show "is_surj(M, x, y, d)"
using is_surj_uniqueness[of x y] is_surj_witness
theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y], of e]
unfolding surj_rel_def
by auto
next
assume "is_surj(M, x, y, d)"
with assms
show "d = surj_rel(M,x,y)"
using is_surj_uniqueness unfolding surj_rel_def
by (blast del:the_equality intro:the_equality[symmetric])
qed
lemma def_surj_rel:
assumes "M(A)" "M(B)"
shows "surj_rel(M,A,B) =
{f â function_space_rel(M,A,B). ây[M]. âx[M]. yâB ⶠxâA ⧠f`x=y }"
(is "_ = Collect(_,?P)")
proof -
from assms
have "surj_rel(M,A,B) â function_space_rel(M,A,B)"
using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
unfolding is_surj_def by auto
moreover from assms
have "f â surj_rel(M,A,B) â¹ ?P(f)" for f
using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
def_surjP_rel transM[OF _ function_space_rel_closed, OF _ â¹M(A)⺠â¹M(B)âº]
unfolding is_surj_def by auto
moreover from assms
have "f â function_space_rel(M,A,B) â¹ ?P(f) â¹ f â surj_rel(M,A,B)" for f
using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
def_surjP_rel transM[OF _ function_space_rel_closed, OF _ â¹M(A)⺠â¹M(B)âº]
unfolding is_surj_def by auto
ultimately
show ?thesis by force
qed
lemma surj_rel_char:
assumes "M(A)" "M(B)"
shows "surj_rel(M,A,B) = {f â surj(A,B). M(f)}"
proof -
from assms
interpret M_Pi_assumptions M A "λ_. B"
using Pi_replacement Pi_separation
by unfold_locales (auto dest:transM simp add:Sigfun_def)
from assms
show ?thesis
using def_surj_rel[OF assms] def_function_space_rel[OF assms]
transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº] Pi_rel_char
unfolding surj_def
by auto
qed
end
locale M_N_surj = M:M_surj + N:M_surj N for N +
assumes
M_imp_N:"M(x) â¹ N(x)"
begin
lemma surj_rel_transfer: "M(A) â¹ M(B) â¹ surj_rel(M,A,B) â surj_rel(N,A,B)"
using M.surj_rel_char N.surj_rel_char
by (auto dest!:M_imp_N)
end
definition
is_Int :: "[iâo,i,i,i]âo" where
"is_Int(M,A,B,I) â¡ M(I) ⧠(âx[M]. x â I â· x â A ⧠x â B)"
reldb_rem relational "inter"
reldb_add absolute relational "ZF_Base.Int" "is_Int"
synthesize "is_Int" from_definition assuming "nonempty"
notation is_Int_fm (â¹_ â© _ is _âº)
context M_basic
begin
lemma is_Int_closed :
"is_Int(M,A,B,I) â¹ M(I)"
unfolding is_Int_def by simp
lemma is_Int_abs:
assumes
"M(A)" "M(B)" "M(I)"
shows
"is_Int(M,A,B,I) â· I = A â© B"
using assms transM[OF _ â¹M(B)âº] transM[OF _ â¹M(I)âº]
unfolding is_Int_def by blast
lemma is_Int_uniqueness:
assumes
"M(r)" "M(B)"
"is_Int(M,r,B,d)" "is_Int(M,r,B,d')"
shows
"d=d'"
proof -
have "M(d)" and "M(d')"
using assms is_Int_closed by simp+
then show ?thesis
using assms is_Int_abs by simp
qed
textâ¹Note: @{thm Int_closed} already in \<^theory>â¹ZF-Constructible.Relativeâº.âº
end
subsectionâ¹Discipline for \<^term>â¹bijâºâº
reldb_add functional "inj" "inj_rel"
reldb_add functional relational "inj_rel" "is_inj"
reldb_add functional "surj" "surj_rel"
reldb_add functional relational "surj_rel" "is_surj"
relativize functional "bij" "bij_rel" external
relationalize "bij_rel" "is_bij"
synthesize "is_bij" from_definition assuming "nonempty"
notation is_bij_fm (â¹â
bij'(_,_') is _â
âº)
abbreviation
bij_r_class :: "[iâo,i,i] â i" (â¹bijâ_â'(_,_')âº) where
"bij_r_class â¡ bij_rel"
abbreviation
bij_r_set :: "[i,i,i] â i" (â¹bijâ_â'(_,_')âº) where
"bij_r_set(M) â¡ bij_rel(##M)"
locale M_Perm = M_Pi + M_inj + M_surj
begin
lemma is_bij_closed : "is_bij(M,f,y,d) â¹ M(d)"
unfolding is_bij_def using is_Int_closed is_inj_witness is_surj_witness by auto
lemma bij_rel_closed[intro,simp]:
assumes "M(x)" "M(y)"
shows "M(bij_rel(M,x,y))"
unfolding bij_rel_def
using assms Int_closed surj_rel_closed inj_rel_closed
by auto
lemmas trans_bij_rel_closed[trans_closed] = transM[OF _ bij_rel_closed]
lemma bij_rel_iff:
assumes "M(x)" "M(y)" "M(d)"
shows "is_bij(M,x,y,d) â· d = bij_rel(M,x,y)"
unfolding is_bij_def bij_rel_def
using assms surj_rel_iff inj_rel_iff is_Int_abs
by auto
lemma def_bij_rel:
assumes "M(A)" "M(B)"
shows "bij_rel(M,A,B) = inj_rel(M,A,B) â© surj_rel(M,A,B)"
using assms bij_rel_iff inj_rel_iff surj_rel_iff
is_Int_abs
unfolding is_bij_def by simp
lemma bij_rel_char:
assumes "M(A)" "M(B)"
shows "bij_rel(M,A,B) = {f â bij(A,B). M(f)}"
using assms def_bij_rel inj_rel_char surj_rel_char
unfolding bij_def
by auto
end
locale M_N_Perm = M_N_Pi + M_N_inj + M_N_surj + M:M_Perm + N:M_Perm N
begin
lemma bij_rel_transfer: "M(A) â¹ M(B) â¹ bij_rel(M,A,B) â bij_rel(N,A,B)"
using M.bij_rel_char N.bij_rel_char
by (auto dest!:M_imp_N)
end
subsectionâ¹Discipline for \<^term>â¹eqpollâºâº
relativize functional "eqpoll" "eqpoll_rel" external
relationalize "eqpoll_rel" "is_eqpoll"
synthesize "is_eqpoll" from_definition assuming "nonempty"
arity_theorem for "is_eqpoll_fm"
notation is_eqpoll_fm (â¹â
_ â _â
âº)
context M_Perm begin
is_iff_rel for "eqpoll"
using bij_rel_iff unfolding is_eqpoll_def eqpoll_rel_def by simp
end
abbreviation
eqpoll_r :: "[i,iâo,i] => o" (â¹_ ââ_â _⺠[51,1,51] 50) where
"A ââMâ B â¡ eqpoll_rel(M,A,B)"
abbreviation
eqpoll_r_set :: "[i,i,i] â o" (â¹_ ââ_â _⺠[51,1,51] 50) where
"eqpoll_r_set(A,M) â¡ eqpoll_rel(##M,A)"
context M_Perm
begin
lemma def_eqpoll_rel:
assumes
"M(A)" "M(B)"
shows
"eqpoll_rel(M,A,B) â· (âf[M]. f â bij_rel(M,A,B))"
using assms bij_rel_iff
unfolding eqpoll_rel_def by simp
end
context M_N_Perm
begin
lemma eqpoll_rel_transfer: assumes "A ââMâ B" "M(A)" "M(B)"
shows "A ââNâ B"
proof -
note assms
moreover from this
obtain f where "f â bijâMâ(A,B)" "N(f)"
using M.def_eqpoll_rel by (auto dest!:M_imp_N)
moreover from calculation
have "f â bijâNâ(A,B)"
using bij_rel_transfer by (auto)
ultimately
show ?thesis
using N.def_eqpoll_rel by (blast dest!:M_imp_N)
qed
end
subsectionâ¹Discipline for \<^term>â¹lepollâºâº
relativize functional "lepoll" "lepoll_rel" external
relationalize "lepoll_rel" "is_lepoll"
synthesize "is_lepoll" from_definition assuming "nonempty"
notation is_lepoll_fm (â¹â
_ â² _â
âº)
arity_theorem for "is_lepoll_fm"
context M_inj begin
is_iff_rel for "lepoll"
using inj_rel_iff unfolding is_lepoll_def lepoll_rel_def by simp
end
abbreviation
lepoll_r :: "[i,iâo,i] => o" (â¹_ â²â_â _⺠[51,1,51] 50) where
"A â²âMâ B â¡ lepoll_rel(M,A,B)"
abbreviation
lepoll_r_set :: "[i,i,i] â o" (â¹_ â²â_â _⺠[51,1,51] 50) where
"lepoll_r_set(A,M) â¡ lepoll_rel(##M,A)"
context M_Perm
begin
lemma def_lepoll_rel:
assumes
"M(A)" "M(B)"
shows
"lepoll_rel(M,A,B) â· (âf[M]. f â inj_rel(M,A,B))"
using assms inj_rel_iff
unfolding lepoll_rel_def by simp
end
context M_N_Perm
begin
lemma lepoll_rel_transfer: assumes "A â²âMâ B" "M(A)" "M(B)"
shows "A â²âNâ B"
proof -
note assms
moreover from this
obtain f where "f â injâMâ(A,B)" "N(f)"
using M.def_lepoll_rel by (auto dest!:M_imp_N)
moreover from calculation
have "f â injâNâ(A,B)"
using inj_rel_transfer by (auto)
ultimately
show ?thesis
using N.def_lepoll_rel by (blast dest!:M_imp_N)
qed
end
subsectionâ¹Discipline for \<^term>â¹lesspollâºâº
relativize functional "lesspoll" "lesspoll_rel" external
relationalize "lesspoll_rel" "is_lesspoll"
synthesize "is_lesspoll" from_definition assuming "nonempty"
notation is_lesspoll_fm (â¹â
_ ⺠_â
âº)
arity_theorem for "is_lesspoll_fm"
context M_Perm begin
is_iff_rel for "lesspoll"
using is_lepoll_iff is_eqpoll_iff
unfolding is_lesspoll_def lesspoll_rel_def by simp
end
abbreviation
lesspoll_r :: "[i,iâo,i] => o" (â¹_ âºâ_â _⺠[51,1,51] 50) where
"A âºâMâ B â¡ lesspoll_rel(M,A,B)"
abbreviation
lesspoll_r_set :: "[i,i,i] â o" (â¹_ âºâ_â _⺠[51,1,51] 50) where
"lesspoll_r_set(A,M) â¡ lesspoll_rel(##M,A)"
textâ¹Since \<^term>â¹lesspoll_rel⺠is defined as a propositional
combination of older terms, there is no need for a separate ``def''
theorem for it.âº
textâ¹Note that \<^term>â¹lesspoll_rel⺠is neither $\Sigma_1^{\mathit{ZF}}$ nor
$\Pi_1^{\mathit{ZF}}$, so there is no ``transfer'' theorem for it.âº
end
Theory Lambda_Replacement
sectionâ¹Replacements using Lambdasâº
theory Lambda_Replacement
imports
Discipline_Function
begin
textâ¹In this theory we prove several instances of separation and replacement
in @{locale M_basic}. Moreover we introduce a new locale assuming two instances
of separation and twelve instances of lambda replacements (ie, replacement of
the form $\lambda x y. y=\langle x, f(x) \rangle$) we prove a bunch of other
instances.âº
definition
lam_replacement :: "[iâo,iâi] â o" where
"lam_replacement(M,b) â¡ strong_replacement(M, λx y. y = â¨x, b(x)â©)"
lemma separation_univ :
shows "separation(M,M)"
unfolding separation_def by auto
context M_basic
begin
lemma separation_iff':
assumes "separation(M,λx . P(x))" "separation(M,λx . Q(x))"
shows "separation(M,λx . P(x) ⷠQ(x))"
using assms separation_conj separation_imp iff_def
by auto
lemma separation_in_constant :
assumes "M(a)"
shows "separation(M,λx . xâa)"
proof -
have "{xâA . xâa} = A â© a" for A by auto
with â¹M(a)âº
show ?thesis using separation_iff Collect_abs
by simp
qed
lemma separation_equal :
shows "separation(M,λx . x=a)"
proof -
have "{xâA . x=a} = (if aâA then {a} else 0)" for A
by auto
then
have "M({xâA . x=a})" if "M(A)" for A
using transM[OF _ â¹M(A)âº] by simp
then
show ?thesis using separation_iff Collect_abs
by simp
qed
lemma (in M_basic) separation_in_rev:
assumes "(M)(a)"
shows "separation(M,λx . aâx)"
proof -
have eq: "{xâA. aâx} = Memrel(Aâª{a}) `` {a}" for A
unfolding ZF_Base.image_def
by(intro equalityI,auto simp:mem_not_refl)
moreover from assms
have "M(Memrel(Aâª{a}) `` {a})" if "M(A)" for A
using that by simp
ultimately
show ?thesis
using separation_iff Collect_abs
by simp
qed
lemma lam_replacement_iff_lam_closed:
assumes "âx[M]. M(b(x))"
shows "lam_replacement(M, b) â· (âA[M]. M(λxâA. b(x)))"
using assms lam_closed lam_funtype[of _ b, THEN Pi_memberD]
unfolding lam_replacement_def strong_replacement_def
by (auto intro:lamI dest:transM)
(rule lam_closed, auto simp add:strong_replacement_def dest:transM)
lemma lam_replacement_imp_lam_closed:
assumes "lam_replacement(M, b)" "M(A)" "âxâA. M(b(x))"
shows "M(λxâA. b(x))"
using assms unfolding lam_replacement_def
by (rule_tac lam_closed, auto simp add:strong_replacement_def dest:transM)
lemma lam_replacement_cong:
assumes "lam_replacement(M,f)" "âx[M]. f(x) = g(x)" "âx[M]. M(f(x))"
shows "lam_replacement(M,g)"
proof -
note assms
moreover from this
have "âA[M]. M(λxâA. f(x))"
using lam_replacement_iff_lam_closed
by simp
moreover from calculation
have "(λxâA . f(x)) = (λxâA . g(x))" if "M(A)" for A
using lam_cong[OF refl,of A f g] transM[OF _ that]
by simp
ultimately
show ?thesis
using lam_replacement_iff_lam_closed
by simp
qed
lemma converse_subset : "converse(r) â {â¨snd(x),fst(x)â© . xâr}"
unfolding converse_def
proof(intro subsetI, auto)
fix u v
assume "â¨u,vâ©âr" (is "?zâr")
moreover
have "v=snd(?z)" "u=fst(?z)" by simp_all
ultimately
show "âzâr. v=snd(z) ⧠u = fst(z)"
using rexI[where x="â¨u,vâ©"] by force
qed
lemma converse_eq_aux :
assumes "<0,0>âr"
shows "converse(r) = {â¨snd(x),fst(x)â© . xâr}"
using converse_subset
proof(intro equalityI subsetI,auto)
fix z
assume "zâr"
then show "â¨fst(z),snd(z)â© â r"
proof(cases "â a b . z =â¨a,bâ©")
case True
with â¹zârâº
show ?thesis by auto
next
case False
then
have "fst(z) = 0" "snd(z)=0"
unfolding fst_def snd_def by auto
with â¹zâr⺠assms
show ?thesis by auto
qed
qed
lemma converse_eq_aux' :
assumes "<0,0>âr"
shows "converse(r) = {â¨snd(x),fst(x)â© . xâr} - {<0,0>}"
using converse_subset assms
proof(intro equalityI subsetI,auto)
fix z
assume "zâr" "snd(z)â 0"
then
obtain a b where "z = â¨a,bâ©" unfolding snd_def by force
with â¹zârâº
show "â¨fst(z),snd(z)â© â r"
by auto
next
fix z
assume "zâr" "fst(z)â 0"
then
obtain a b where "z = â¨a,bâ©" unfolding fst_def by force
with â¹zârâº
show "â¨fst(z),snd(z)â© â r"
by auto
qed
lemma diff_un : "bâa â¹ (a-b) ⪠b = a"
by auto
lemma converse_eq: "converse(r) = ({â¨snd(x),fst(x)â© . xâr} - {<0,0>}) ⪠(râ©{<0,0>})"
proof(cases "<0,0>âr")
case True
then
have "converse(r) = {â¨snd(x),fst(x)â© . xâr}"
using converse_eq_aux by auto
moreover
from True
have "râ©{<0,0>} = {<0,0>}" "{<0,0>}â{â¨snd(x),fst(x)â© . xâr}"
using converse_subset by auto
moreover from this True
have "{â¨snd(x),fst(x)â© . xâr} = ({â¨snd(x),fst(x)â© . xâr} - {<0,0>}) ⪠({<0,0>})"
using diff_un[of "{<0,0>}",symmetric] converse_eq_aux by auto
ultimately
show ?thesis
by simp
next
case False
then
have "râ©{<0,0>} = 0" by auto
then
have "({â¨snd(x),fst(x)â© . xâr} - {<0,0>}) ⪠(râ©{<0,0>}) = ({â¨snd(x),fst(x)â© . xâr} - {<0,0>})"
by simp
with False
show ?thesis
using converse_eq_aux' by auto
qed
lemma range_subset : "range(r) â {snd(x). xâr}"
unfolding range_def domain_def converse_def
proof(intro subsetI, auto)
fix u v
assume "â¨u,vâ©âr" (is "?zâr")
moreover
have "v=snd(?z)" "u=fst(?z)" by simp_all
ultimately
show "âzâr. v=snd(z)"
using rexI[where x="v"] by force
qed
lemma lam_replacement_imp_strong_replacement_aux:
assumes "lam_replacement(M, b)" "âx[M]. M(b(x))"
shows "strong_replacement(M, λx y. y = b(x))"
proof -
{
fix A
note assms
moreover
assume "M(A)"
moreover from calculation
have "M(λxâA. b(x))" using lam_replacement_iff_lam_closed by auto
ultimately
have "M((λxâA. b(x))``A)" "âz[M]. z â (λxâA. b(x))``A â· (âxâA. z = b(x))"
by (auto simp:lam_def)
}
then
show ?thesis unfolding strong_replacement_def
by clarsimp (rule_tac x="(λxâA. b(x))``A" in rexI, auto)
qed
lemma lam_replacement_imp_RepFun_Lam:
assumes "lam_replacement(M, f)" "M(A)"
shows "M({y . xâA , M(y) ⧠y=â¨x,f(x)â©})"
proof -
from assms
obtain Y where 1:"M(Y)" "âb[M]. b â Y â· (âx[M]. x â A ⧠b = â¨x,f(x)â©)"
unfolding lam_replacement_def strong_replacement_def
by auto
moreover from calculation
have "Y = {y . xâA , M(y) ⧠y = â¨x,f(x)â©}" (is "Y=?R")
proof(intro equalityI subsetI)
fix y
assume "yâY"
moreover from this 1
obtain x where "xâA" "y=â¨x,f(x)â©" "M(y)"
using transM[OF _ â¹M(Y)âº] by auto
ultimately
show "yâ?R"
by auto
next
fix z
assume "zâ?R"
moreover from this
obtain a where "aâA" "z=â¨a,f(a)â©" "M(a)" "M(f(a))"
using transM[OF _ â¹M(A)âº]
by auto
ultimately
show "zâY" using 1 by simp
qed
ultimately
show ?thesis by auto
qed
lemma lam_closed_imp_closed:
assumes "âA[M]. M(λxâA. f(x))"
shows "âx[M]. M(f(x))"
proof
fix x
assume "M(x)"
moreover from this and assms
have "M(λxâ{x}. f(x))" by simp
ultimately
show "M(f(x))"
using image_lam[of "{x}" "{x}" f]
image_closed[of "{x}" "(λxâ{x}. f(x))"] by (auto dest:transM)
qed
lemma lam_replacement_if:
assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "separation(M,b)"
"âx[M]. M(f(x))" "âx[M]. M(g(x))"
shows "lam_replacement(M, λx. if b(x) then f(x) else g(x))"
proof -
let ?G="λx. if b(x) then f(x) else g(x)"
let ?b="λA . {xâA. b(x)}" and ?b'="λA . {xâA. ¬b(x)}"
have eq:"(λxâA . ?G(x)) = (λxâ?b(A) . f(x)) ⪠(λxâ?b'(A).g(x))" for A
unfolding lam_def by auto
have "?b'(A) = A - ?b(A)" for A by auto
moreover
have "M(?b(A))" if "M(A)" for A using assms that by simp
moreover from calculation
have "M(?b'(A))" if "M(A)" for A using that by simp
moreover from calculation assms
have "M(λxâ?b(A). f(x))" "M(λxâ?b'(A) . g(x))" if "M(A)" for A
using lam_replacement_iff_lam_closed that
by simp_all
moreover from this
have "M((λxâ?b(A) . f(x)) ⪠(λxâ?b'(A).g(x)))" if "M(A)" for A
using that by simp
ultimately
have "M(λxâA. if b(x) then f(x) else g(x))" if "M(A)" for A
using that eq by simp
with assms
show ?thesis using lam_replacement_iff_lam_closed by simp
qed
lemma lam_replacement_constant: "M(b) ⹠lam_replacement(M,λ_. b)"
unfolding lam_replacement_def strong_replacement_def
by safe (rule_tac x="_Ã{b}" in rexI; blast)
subsectionâ¹Replacement instances obtained through Powersetâº
txtâ¹The next few lemmas provide bounds for certain constructions.âº
lemma not_functional_Replace_0:
assumes "¬(ây y'. P(y) ⧠P(y') ⶠy=y')"
shows "{y . x â A, P(y)} = 0"
using assms by (blast elim!: ReplaceE)
lemma Replace_in_Pow_rel:
assumes "âx b. x â A â¹ P(x,b) â¹ b â U" "âxâA. ây y'. P(x,y) ⧠P(x,y') ⶠy=y'"
"separation(M, λy. âx[M]. x â A ⧠P(x, y))"
"M(U)" "M(A)"
shows "{y . x â A, P(x, y)} â PowâMâ(U)"
proof -
from assms
have "{y . x â A, P(x, y)} â U"
"z â {y . x â A, P(x, y)} â¹ M(z)" for z
by (auto dest:transM)
with assms
have "{y . x â A, P(x, y)} = {yâU . âx[M]. xâA ⧠P(x,y)}"
by (intro equalityI) (auto, blast)
with assms
have "M({y . x â A, P(x, y)})"
by simp
with assms
show ?thesis
using mem_Pow_rel_abs by auto
qed
lemma Replace_sing_0_in_Pow_rel:
assumes "âb. P(b) â¹ b â U"
"separation(M, λy. P(y))" "M(U)"
shows "{y . x â {0}, P(y)} â PowâMâ(U)"
proof (cases "ây y'. P(y) ⧠P(y') ⶠy=y'")
case True
with assms
show ?thesis by (rule_tac Replace_in_Pow_rel) auto
next
case False
with assms
show ?thesis
using nonempty not_functional_Replace_0[of P "{0}"] Pow_rel_char by auto
qed
lemma The_in_Pow_rel_Union:
assumes "âb. P(b) â¹ b â U" "separation(M, λy. P(y))" "M(U)"
shows "(THE i. P(i)) â PowâMâ(âU)"
proof -
note assms
moreover from this
have "(THE i. P(i)) â Pow(âU)"
unfolding the_def by auto
moreover from assms
have "M(THE i. P(i))"
using Replace_sing_0_in_Pow_rel[of P U] unfolding the_def
by (auto dest:transM)
ultimately
show ?thesis
using Pow_rel_char by auto
qed
lemma separation_least: "separation(M, λy. Ord(y) ⧠P(y) ⧠(âj. j < y ⶠ¬ P(j)))"
unfolding separation_def
proof
fix z
assume "M(z)"
have "M({x â z . x â z ⧠Ord(x) ⧠P(x) ⧠(âj. j < x ⶠ¬ P(j))})"
(is "M(?y)")
proof (cases "âxâz. Ord(x) ⧠P(x) ⧠(âj. j < x ⶠ¬ P(j))")
case True
with â¹M(z)âº
have "âx[M]. ?y = {x}"
by (safe, rename_tac x, rule_tac x=x in rexI)
(auto dest:transM, intro equalityI, auto elim:Ord_linear_lt)
then
show ?thesis
by auto
next
case False
then
have "{x â z . x â z ⧠Ord(x) ⧠P(x) ⧠(âj. j < x ⶠ¬ P(j))} = 0"
by auto
then
show ?thesis by auto
qed
moreover from this
have "âx[M]. x â ?y â· x â z ⧠Ord(x) ⧠P(x) ⧠(âj. j < x ⶠ¬ P(j))" by simp
ultimately
show "ây[M]. âx[M]. x â y â· x â z ⧠Ord(x) ⧠P(x) ⧠(âj. j < x ⶠ¬ P(j))"
by blast
qed
lemma Least_in_Pow_rel_Union:
assumes "âb. P(b) â¹ b â U"
"M(U)"
shows "(μ i. P(i)) â PowâMâ(âU)"
using assms separation_least unfolding Least_def
by (rule_tac The_in_Pow_rel_Union) simp
lemma bounded_lam_replacement:
fixes U
assumes "âX[M]. âxâX. f(x) â U(X)"
and separation_f:"âA[M]. separation(M,λy. âx[M]. xâA ⧠y = â¨x, f(x)â©)"
and U_closed [intro,simp]: "âX. M(X) â¹ M(U(X))"
shows "lam_replacement(M, f)"
proof -
have "M(λxâA. f(x))" if "M(A)" for A
proof -
have "(λxâA. f(x)) = {yâ PowâMâ(PowâMâ(A ⪠U(A))). âx[M]. xâA ⧠y = â¨x, f(x)â©}"
using â¹M(A)⺠unfolding lam_def
proof (intro equalityI, auto)
fix x
assume "xâA"
moreover
note â¹M(A)âº
moreover from calculation assms
have "f(x) â U(A)" by simp
moreover from calculation
have "{x, f(x)} â PowâMâ(A ⪠U(A))" "{x,x} â PowâMâ(A ⪠U(A))"
using Pow_rel_char[of "A ⪠U(A)"] by (auto dest:transM)
ultimately
show "â¨x, f(x)â© â PowâMâ(PowâMâ(A ⪠U(A)))"
using Pow_rel_char[of "PowâMâ(A ⪠U(A))"] unfolding Pair_def
by (auto dest:transM)
qed
moreover from â¹M(A)âº
have "M({yâ PowâMâ(PowâMâ(A ⪠U(A))). âx[M]. xâA ⧠y = â¨x, f(x)â©})"
using separation_f
by (rule_tac separation_closed) simp_all
ultimately
show ?thesis
by simp
qed
moreover from this
have "âx[M]. M(f(x))"
using lam_closed_imp_closed by simp
ultimately
show ?thesis
using assms
by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2]) simp_all
qed
lemma lam_replacement_domain':
assumes "âA[M]. separation(M, λy. âxâA. y = â¨x, domain(x)â©)"
shows "lam_replacement(M,domain)"
proof -
have "âxâX. domain(x) â PowâMâ(âââX)" if "M(X)" for X
proof
fix x
assume "xâX"
moreover
note â¹M(X)âº
moreover from calculation
have "M(x)" by (auto dest:transM)
ultimately
show "domain(x) â PowâMâ(âââX)"
by(rule_tac mem_Pow_rel_abs[of "domain(x)" "âââX",THEN iffD2],auto simp:Pair_def,force)
qed
with assms
show ?thesis
using bounded_lam_replacement[of domain "λX. PowâMâ(âââX)"] by simp
qed
lemma lam_replacement_fst':
assumes "âA[M]. separation(M, λy. âxâA. y = â¨x, fst(x)â©)"
shows "lam_replacement(M,fst)"
proof -
have "âxâX. fst(x) â {0} ⪠ââX" if "M(X)" for X
proof
fix x
assume "xâX"
moreover
note â¹M(X)âº
moreover from calculation
have "M(x)" by (auto dest:transM)
ultimately
show "fst(x) â {0} ⪠ââX" unfolding fst_def Pair_def
by (auto, rule_tac [1] the_0) force
qed
with assms
show ?thesis
using bounded_lam_replacement[of fst "λX. {0} ⪠ââX"] by simp
qed
lemma lam_replacement_restrict:
assumes "âA[M]. separation(M, λy. âxâA. y = â¨x, restrict(x,B)â©)" "M(B)"
shows "lam_replacement(M, λr . restrict(r,B))"
proof -
have "ârâR. restrict(r,B)âPowâMâ(âR)" if "M(R)" for R
proof -
{
fix r
assume "râR"
with â¹M(B)âº
have "restrict(r,B)âPow(âR)" "M(restrict(r,B))"
using Union_upper subset_Pow_Union subset_trans[OF restrict_subset]
transM[OF _ â¹M(R)âº]
by simp_all
} then show ?thesis
using Pow_rel_char that by simp
qed
with assms
show ?thesis
using bounded_lam_replacement[of "λr . restrict(r,B)" "λX. PowâMâ(âX)"]
by simp
qed
end
locale M_replacement = M_basic +
assumes
lam_replacement_domain: "lam_replacement(M,domain)"
and
lam_replacement_fst: "lam_replacement(M,fst)"
and
lam_replacement_snd: "lam_replacement(M,snd)"
and
lam_replacement_Union: "lam_replacement(M,Union)"
and
middle_del_replacement: "strong_replacement(M, λx y. y=â¨fst(fst(x)),snd(snd(x))â©)"
and
product_replacement:
"strong_replacement(M, λx y. y=â¨snd(fst(x)),â¨fst(fst(x)),snd(snd(x))â©â©)"
and
lam_replacement_Upair:"lam_replacement(M, λp. Upair(fst(p),snd(p)))"
and
lam_replacement_Diff:"lam_replacement(M, λp. fst(p) - snd(p))"
and
lam_replacement_Image:"lam_replacement(M, λp. fst(p) `` snd(p))"
and
middle_separation: "separation(M, λx. snd(fst(x))=fst(snd(x)))"
and
separation_fst_in_snd: "separation(M, λy. fst(snd(y)) â snd(snd(y)))"
and
lam_replacement_converse : "lam_replacement(M,converse)"
and
lam_replacement_comp: "lam_replacement(M, λx. fst(x) O snd(x))"
begin
lemma lam_replacement_imp_strong_replacement:
assumes "lam_replacement(M, f)"
shows "strong_replacement(M, λx y. y = f(x))"
proof -
{
fix A
assume "M(A)"
moreover from calculation assms
obtain Y where 1:"M(Y)" "âb[M]. b â Y â· (âx[M]. x â A ⧠b = â¨x,f(x)â©)"
unfolding lam_replacement_def strong_replacement_def
by auto
moreover from this
have "M({snd(b) . b â Y})"
using transM[OF _ â¹M(Y)âº] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
RepFun_closed by simp
moreover
have "{snd(b) . b â Y} = {y . xâA , M(f(x)) ⧠y=f(x)}" (is "?L=?R")
proof(intro equalityI subsetI)
fix x
assume "xâ?L"
moreover from this
obtain b where "bâY" "x=snd(b)" "M(b)"
using transM[OF _ â¹M(Y)âº] by auto
moreover from this 1
obtain a where "aâA" "b=â¨a,f(a)â©" by auto
moreover from calculation
have "x=f(a)" by simp
ultimately show "xâ?R"
by auto
next
fix z
assume "zâ?R"
moreover from this
obtain a where "aâA" "z=f(a)" "M(a)" "M(f(a))"
using transM[OF _ â¹M(A)âº]
by auto
moreover from calculation this 1
have "z=snd(â¨a,f(a)â©)" "â¨a,f(a)â© â Y" by auto
ultimately
show "zâ?L" by force
qed
ultimately
have "âZ[M]. âz[M]. zâZ â· (âa[M]. aâA ⧠z=f(a))"
by (rule_tac rexI[where x="{snd(b) . b â Y}"],auto)
}
then
show ?thesis unfolding strong_replacement_def by simp
qed
lemma Collect_middle: "{p â (λxâA. f(x)) à (λxâ{f(x) . xâA}. g(x)) . snd(fst(p))=fst(snd(p))}
= { â¨â¨x,f(x)â©,â¨f(x),g(f(x))â©â© . xâA }"
by (intro equalityI; auto simp:lam_def)
lemma RepFun_middle_del: "{ â¨fst(fst(p)),snd(snd(p))â© . p â { â¨â¨x,f(x)â©,â¨f(x),g(f(x))â©â© . xâA }}
= { â¨x,g(f(x))â© . xâA }"
by auto
lemma lam_replacement_imp_RepFun:
assumes "lam_replacement(M, f)" "M(A)"
shows "M({y . xâA , M(y) ⧠y=f(x)})"
proof -
from assms
obtain Y where 1:"M(Y)" "âb[M]. b â Y â· (âx[M]. x â A ⧠b = â¨x,f(x)â©)"
unfolding lam_replacement_def strong_replacement_def
by auto
moreover from this
have "M({snd(b) . b â Y})"
using transM[OF _ â¹M(Y)âº] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
RepFun_closed by simp
moreover
have "{snd(b) . b â Y} = {y . xâA , M(y) ⧠y=f(x)}" (is "?L=?R")
proof(intro equalityI subsetI)
fix x
assume "xâ?L"
moreover from this
obtain b where "bâY" "x=snd(b)" "M(b)"
using transM[OF _ â¹M(Y)âº] by auto
moreover from this 1
obtain a where "aâA" "b=â¨a,f(a)â©" by auto
moreover from calculation
have "x=f(a)" by simp
ultimately show "xâ?R"
by auto
next
fix z
assume "zâ?R"
moreover from this
obtain a where "aâA" "z=f(a)" "M(a)" "M(f(a))"
using transM[OF _ â¹M(A)âº]
by auto
moreover from calculation this 1
have "z=snd(â¨a,f(a)â©)" "â¨a,f(a)â© â Y" by auto
ultimately
show "zâ?L" by force
qed
ultimately
show ?thesis by simp
qed
lemma lam_replacement_product:
assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
shows "lam_replacement(M, λx. â¨f(x),g(x)â©)"
proof -
{
fix A
let ?Y="{y . xâA , M(y) ⧠y=f(x)}"
let ?Y'="{y . xâA ,M(y) ⧠y=â¨x,f(x)â©}"
let ?Z="{y . xâA , M(y) ⧠y=g(x)}"
let ?Z'="{y . xâA ,M(y) ⧠y=â¨x,g(x)â©}"
have "xâC â¹ yâC â¹ fst(x) = fst(y) ⶠM(fst(y)) ⧠M(snd(x)) ⧠M(snd(y))" if "M(C)" for C y x
using transM[OF _ that] by auto
moreover
note assms
moreover
assume "M(A)"
moreover from â¹M(A)⺠assms(1)
have "M(converse(?Y'))" "M(?Y)"
using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
moreover from calculation
have "M(?Z)" "M(?Z')"
using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
moreover from calculation
have "M(converse(?Y')Ã?Z')"
by simp
moreover from this
have "M({p â converse(?Y')Ã?Z' . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
using middle_separation by simp
moreover from calculation
have "M({ â¨snd(fst(p)),â¨fst(fst(p)),snd(snd(p))â©â© . pâ?P })" (is "M(?R)")
using RepFun_closed[OF product_replacement â¹M(?P)⺠] by simp
ultimately
have "b â ?R â· (âx[M]. x â A ⧠b = â¨x,â¨f(x),g(x)â©â©)" if "M(b)" for b
using that
apply(intro iffI)apply(auto)[1]
proof -
assume " âx[M]. x â A ⧠b = â¨x, f(x), g(x)â©"
moreover from this
obtain x where "M(x)" "xâA" "b= â¨x, â¨f(x), g(x)â©â©"
by auto
moreover from calculation that
have "M(â¨x,f(x)â©)" "M(â¨x,g(x)â©)" by auto
moreover from calculation
have "â¨f(x),xâ© â converse(?Y')" "â¨x,g(x)â© â ?Z'" by auto
moreover from calculation
have "â¨â¨f(x),xâ©,â¨x,g(x)â©â©âconverse(?Y')Ã?Z'" by auto
moreover from calculation
have "â¨â¨f(x),xâ©,â¨x,g(x)â©â© â ?P"
(is "?pâ?P")
by auto
moreover from calculation
have "b = â¨snd(fst(?p)),â¨fst(fst(?p)),snd(snd(?p))â©â©" by auto
moreover from calculation
have "â¨snd(fst(?p)),â¨fst(fst(?p)),snd(snd(?p))â©â©â?R"
by(rule_tac RepFunI[of ?p ?P], simp)
ultimately show "bâ?R" by simp
qed
with â¹M(?R)âº
have "âY[M]. âb[M]. b â Y â· (âx[M]. x â A ⧠b = â¨x,â¨f(x),g(x)â©â©)"
by (rule_tac rexI[where x="?R"],simp_all)
}
with assms
show ?thesis using lam_replacement_def strong_replacement_def by simp
qed
lemma lam_replacement_hcomp:
assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "âx[M]. M(f(x))"
shows "lam_replacement(M, λx. g(f(x)))"
proof -
{
fix A
let ?Y="{y . xâA , y=f(x)}"
let ?Y'="{y . xâA , y=â¨x,f(x)â©}"
have "âxâC. M(â¨fst(fst(x)),snd(snd(x))â©)" if "M(C)" for C
using transM[OF _ that] by auto
moreover
note assms
moreover
assume "M(A)"
moreover from assms
have eq:"?Y = {y . xâA ,M(y) ⧠y=f(x)}" "?Y' = {y . xâA ,M(y) ⧠y=â¨x,f(x)â©}"
using transM[OF _ â¹M(A)âº] by auto
moreover from â¹M(A)⺠assms(1)
have "M(?Y')" "M(?Y)"
using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun eq by auto
moreover from calculation
have "M({z . yâ?Y , M(z) ⧠z=â¨y,g(y)â©})" (is "M(?Z)")
using lam_replacement_imp_RepFun_Lam by auto
moreover from calculation
have "M(?Y'Ã?Z)"
by simp
moreover from this
have "M({p â ?Y'Ã?Z . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
using middle_separation by simp
moreover from calculation
have "M({ â¨fst(fst(p)),snd(snd(p))â© . pâ?P })" (is "M(?R)")
using RepFun_closed[OF middle_del_replacement â¹M(?P)âº] by simp
ultimately
have "b â ?R â· (âx[M]. x â A ⧠b = â¨x,g(f(x))â©)" if "M(b)" for b
using that assms(3)
apply(intro iffI) apply(auto)[1]
proof -
assume "âx[M]. x â A ⧠b = â¨x, g(f(x))â©"
moreover from this
obtain x where "M(x)" "xâA" "b= â¨x, g(f(x))â©"
by auto
moreover from calculation that assms(3)
have "M(f(x))" "M(g(f(x)))" by auto
moreover from calculation
have "â¨x,f(x)â© â ?Y'" by auto
moreover from calculation
have "â¨f(x),g(f(x))â©â?Z" by auto
moreover from calculation
have "â¨â¨x,f(x)â©,â¨f(x),g(f(x))â©â© â ?P"
(is "?pâ?P")
by auto
moreover from calculation
have "b = â¨fst(fst(?p)),snd(snd(?p))â©" by auto
moreover from calculation
have "â¨fst(fst(?p)),snd(snd(?p))â©â?R"
by(rule_tac RepFunI[of ?p ?P], simp)
ultimately show "bâ?R" by simp
qed
with â¹M(?R)âº
have "âY[M]. âb[M]. b â Y â· (âx[M]. x â A ⧠b = â¨x,g(f(x))â©)"
by (rule_tac rexI[where x="?R"],simp_all)
}
with assms
show ?thesis using lam_replacement_def strong_replacement_def by simp
qed
lemma lam_replacement_Collect :
assumes "M(A)" "âx[M]. separation(M,F(x))"
"separation(M,λp . âxâA. xâsnd(p) â· F(fst(p),x))"
shows "lam_replacement(M,λx. {yâA . F(x,y)})"
proof -
{
fix Z
let ?Y="λz.{xâA . F(z,x)}"
assume "M(Z)"
moreover from this
have "M(?Y(z))" if "zâZ" for z
using assms that transM[of _ Z] by simp
moreover from this
have "?Y(z)âPowâMâ(A)" if "zâZ" for z
using Pow_rel_char that assms by auto
moreover from calculation â¹M(A)âº
have "M(ZÃPowâMâ(A))" by simp
moreover from this
have "M({p â ZÃPowâMâ(A) . âxâA. xâsnd(p) â· F(fst(p),x)})" (is "M(?P)")
using assms by simp
ultimately
have "b â ?P â· (âz[M]. zâZ ⧠b=â¨z,?Y(z)â©)" if "M(b)" for b
using assms(1) Pow_rel_char[OF â¹M(A)âº] that
by(intro iffI,auto,intro equalityI,auto)
with â¹M(?P)âº
have "âY[M]. âb[M]. b â Y â· (âz[M]. z â Z ⧠b = â¨z,?Y(z)â©)"
by (rule_tac rexI[where x="?P"],simp_all)
}
then
show ?thesis
unfolding lam_replacement_def strong_replacement_def
by simp
qed
lemma lam_replacement_hcomp2:
assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
"âx[M]. M(f(x))" "âx[M]. M(g(x))"
"lam_replacement(M, λp. h(fst(p),snd(p)))"
"âx[M]. ây[M]. M(h(x,y))"
shows "lam_replacement(M, λx. h(f(x),g(x)))"
using assms lam_replacement_product[of f g]
lam_replacement_hcomp[of "λx. â¨f(x), g(x)â©" "λâ¨x,yâ©. h(x,y)"]
unfolding split_def by simp
lemma lam_replacement_identity: "lam_replacement(M,λx. x)"
proof -
{
fix A
assume "M(A)"
moreover from this
have "id(A) = {â¨snd(fst(z)),fst(snd(z))â© . zâ {zâ (AÃA)Ã(AÃA). snd(fst(z)) = fst(snd(z))}}"
unfolding id_def lam_def
by(intro equalityI subsetI,simp_all,auto)
moreover from calculation
have "M({zâ (AÃA)Ã(AÃA). snd(fst(z)) = fst(snd(z))})" (is "M(?A')")
using middle_separation by simp
moreover from calculation
have "M({â¨snd(fst(z)),fst(snd(z))â© . zâ ?A'})"
using transM[of _ A]
lam_replacement_product lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
lam_replacement_imp_strong_replacement[THEN RepFun_closed]
by simp_all
ultimately
have "M(id(A))" by simp
}
then
show ?thesis using lam_replacement_iff_lam_closed
unfolding id_def by simp
qed
lemma lam_replacement_vimage :
shows "lam_replacement(M, λx. fst(x)-``snd(x))"
unfolding vimage_def using
lam_replacement_hcomp2[OF
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_converse] lam_replacement_snd
_ _ lam_replacement_Image]
by auto
lemma strong_replacement_separation_aux :
assumes "strong_replacement(M,λ x y . y=f(x))" "separation(M,P)"
shows "strong_replacement(M, λx y . P(x) ⧠y=f(x))"
proof -
{
fix A
let ?Q="λX. âb[M]. b â X â· (âx[M]. x â A ⧠P(x) ⧠b = f(x))"
assume "M(A)"
moreover from this
have "M({xâA . P(x)})" (is "M(?B)") using assms by simp
moreover from calculation assms
obtain Y where "M(Y)" "âb[M]. b â Y â· (âx[M]. x â ?B ⧠b = f(x))"
unfolding strong_replacement_def by auto
then
have "âY[M]. âb[M]. b â Y â· (âx[M]. x â A ⧠P(x) ⧠b = f(x))"
using rexI[of ?Q _ M] by simp
}
then
show ?thesis
unfolding strong_replacement_def by simp
qed
lemma separation_in:
assumes "âx[M]. M(f(x))" "lam_replacement(M,f)"
"âx[M]. M(g(x))" "lam_replacement(M,g)"
shows "separation(M,λx . f(x)âg(x))"
proof -
let ?Z="λA. {â¨x,â¨f(x),g(x)â©â©. xâA}"
have "M(?Z(A))" if "M(A)" for A
using assms lam_replacement_iff_lam_closed that
lam_replacement_product[of f g]
unfolding lam_def
by auto
then
have "M({uâ?Z(A) . fst(snd(u)) âsnd(snd(u))})" (is "M(?W(A))") if "M(A)" for A
using that separation_fst_in_snd assms
by auto
then
have "M({fst(u) . u â ?W(A)})" if "M(A)" for A
using that lam_replacement_imp_strong_replacement[OF lam_replacement_fst,THEN
RepFun_closed] fst_closed[OF transM]
by auto
moreover
have "{xâA. f(x)âg(x)} = {fst(u) . uâ?W(A)}" for A
by auto
ultimately
show ?thesis
using separation_iff
by auto
qed
lemma lam_replacement_swap: "lam_replacement(M, λx. â¨snd(x),fst(x)â©)"
using lam_replacement_fst lam_replacement_snd
lam_replacement_product[of "snd" "fst"] by simp
lemma lam_replacement_range : "lam_replacement(M,range)"
unfolding range_def
using lam_replacement_hcomp[OF lam_replacement_converse lam_replacement_domain]
by auto
lemma separation_in_range : "M(a) â¹ separation(M, λx. aârange(x))"
using lam_replacement_range lam_replacement_constant separation_in
by auto
lemma separation_in_domain : "M(a) â¹ separation(M, λx. aâdomain(x))"
using lam_replacement_domain lam_replacement_constant separation_in
by auto
lemma lam_replacement_separation :
assumes "lam_replacement(M,f)" "separation(M,P)"
shows "strong_replacement(M, λx y . P(x) ⧠y=â¨x,f(x)â©)"
using strong_replacement_separation_aux assms
unfolding lam_replacement_def
by simp
lemmas strong_replacement_separation =
strong_replacement_separation_aux[OF lam_replacement_imp_strong_replacement]
lemma id_closed: "M(A) â¹ M(id(A))"
using lam_replacement_identity lam_replacement_iff_lam_closed
unfolding id_def by simp
lemma relation_separation: "separation(M, λz. âx y. z = â¨x, yâ©)"
unfolding separation_def
proof (clarify)
fix A
assume "M(A)"
moreover from this
have "{zâA. âx y. z = â¨x, yâ©} = {zâA. âxâdomain(A). âyârange(A). pair(M, x, y, z)}"
(is "?rel = _")
by (intro equalityI, auto dest:transM)
(intro bexI, auto dest:transM simp:Pair_def)
moreover from calculation
have "M(?rel)"
using cartprod_separation[THEN separation_closed, of "domain(A)" "range(A)" A]
by simp
ultimately
show "ây[M]. âx[M]. x â y â· x â A ⧠(âw y. x = â¨w, yâ©)"
by (rule_tac x="{zâA. âx y. z = â¨x, yâ©}" in rexI) auto
qed
lemma separation_pair:
assumes "separation(M, λy . P(fst(y), snd(y)))"
shows "separation(M, λy. â u v . y=â¨u,v⩠⧠P(u,v))"
unfolding separation_def
proof(clarify)
fix A
assume "M(A)"
moreover from this
have "M({zâA. âx y. z = â¨x, yâ©})" (is "M(?P)")
using relation_separation by simp
moreover from this assms
have "M({zâ?P . P(fst(z),snd(z))})"
by(rule_tac separation_closed,simp_all)
moreover
have "{yâA . â u v . y=â¨u,v⩠⧠P(u,v) } = {zâ?P . P(fst(z),snd(z))}"
by(rule equalityI subsetI,auto)
moreover from calculation
have "M({yâA . â u v . y=â¨u,v⩠⧠P(u,v) })"
by simp
ultimately
show "ây[M]. âx[M]. x â y â· x â A ⧠(âw y. x = â¨w, y⩠⧠P(w,y))"
by (rule_tac x="{zâA. âx y. z = â¨x, y⩠⧠P(x,y)}" in rexI) auto
qed
lemma lam_replacement_Pair:
shows "lam_replacement(M, λx. â¨fst(x), snd(x)â©)"
unfolding lam_replacement_def strong_replacement_def
proof (clarsimp)
fix A
assume "M(A)"
then
show "âY[M]. âb[M]. b â Y â· (âxâA. b = â¨x, fst(x), snd(x)â©)"
unfolding lam_replacement_def strong_replacement_def
proof (cases "relation(A)")
case True
with â¹M(A)âº
show ?thesis
using id_closed unfolding relation_def
by (rule_tac x="id(A)" in rexI) auto
next
case False
moreover
note â¹M(A)âº
moreover from this
have "M({zâA. âx y. z = â¨x, yâ©})" (is "M(?rel)")
using relation_separation by auto
moreover
have "z = â¨fst(z), snd(z)â©" if "fst(z) â 0 ⨠snd(z) â 0" for z
using that
by (cases "âa b. z=â¨a,bâ©") (auto simp add: the_0 fst_def snd_def)
ultimately
show ?thesis
using id_closed unfolding relation_def
by (rule_tac x="id(?rel) ⪠(A-?rel)Ã{0}Ã{0}" in rexI)
(force simp:fst_def snd_def)+
qed
qed
lemma lam_replacement_Un: "lam_replacement(M, λp. fst(p) ⪠snd(p))"
using lam_replacement_Upair lam_replacement_Union
lam_replacement_hcomp[where g=Union and f="λp. Upair(fst(p),snd(p))"]
unfolding Un_def by simp
lemma lam_replacement_cons: "lam_replacement(M, λp. cons(fst(p),snd(p)))"
using lam_replacement_Upair
lam_replacement_hcomp2[of _ _ "(âª)"]
lam_replacement_hcomp2[of fst fst "Upair"]
lam_replacement_Un lam_replacement_fst lam_replacement_snd
unfolding cons_def
by auto
lemma lam_replacement_sing: "lam_replacement(M, λx. {x})"
using lam_replacement_constant lam_replacement_cons
lam_replacement_hcomp2[of "λx. x" "λ_. 0" cons]
by (force intro: lam_replacement_identity)
lemmas tag_replacement = lam_replacement_constant[unfolded lam_replacement_def]
lemma lam_replacement_id2: "lam_replacement(M, λx. â¨x, xâ©)"
using lam_replacement_identity lam_replacement_product[of "λx. x" "λx. x"]
by simp
lemmas id_replacement = lam_replacement_id2[unfolded lam_replacement_def]
lemma lam_replacement_apply2:"lam_replacement(M, λp. fst(p) ` snd(p))"
using lam_replacement_sing lam_replacement_fst lam_replacement_snd
lam_replacement_Image lam_replacement_Union
unfolding apply_def
by (rule_tac lam_replacement_hcomp[of _ Union],
rule_tac lam_replacement_hcomp2[of _ _ "(``)"])
(force intro:lam_replacement_hcomp)+
definition map_snd where
"map_snd(X) = {snd(z) . zâX}"
lemma map_sndE: "yâmap_snd(X) â¹ âpâX. y=snd(p)"
unfolding map_snd_def by auto
lemma map_sndI : "âpâX. y=snd(p) â¹ yâmap_snd(X)"
unfolding map_snd_def by auto
lemma map_snd_closed: "M(x) â¹ M(map_snd(x))"
unfolding map_snd_def
using lam_replacement_imp_strong_replacement[OF lam_replacement_snd]
RepFun_closed snd_closed[OF transM[of _ x]]
by simp
lemma lam_replacement_imp_lam_replacement_RepFun:
assumes "lam_replacement(M, f)" "âx[M]. M(f(x))"
"separation(M, λx. ((âyâsnd(x). fst(y) â fst(x)) ⧠(âyâfst(x). âuâsnd(x). y=fst(u))))"
and
lam_replacement_RepFun_snd:"lam_replacement(M,map_snd)"
shows "lam_replacement(M, λx. {f(y) . yâx})"
proof -
have f_closed:"M(â¨fst(z),map_snd(snd(z))â©)" if "M(z)" for z
using pair_in_M_iff fst_closed snd_closed map_snd_closed that
by simp
have p_closed:"M(â¨x,{f(y) . yâx}â©)" if "M(x)" for x
using pair_in_M_iff RepFun_closed lam_replacement_imp_strong_replacement
transM[OF _ that] that assms by auto
{
fix A
assume "M(A)"
then
have "M({â¨y,f(y)â© . yâx})" if "xâA" for x
using lam_replacement_iff_lam_closed assms that transM[of _ A]
unfolding lam_def by simp
from assms â¹M(A)âº
have "âxââA. M(f(x))"
using transM[of _ "âA"] by auto
with assms â¹M(A)âº
have "M({â¨y,f(y)â© . y â âA})" (is "M(?fUnA)")
using lam_replacement_iff_lam_closed[THEN iffD1,OF assms(2) assms(1)]
unfolding lam_def
by simp
with â¹M(A)âº
have "M(Pow_rel(M,?fUnA))" by simp
with â¹M(A)âº
have "M({zâAÃPow_rel(M,?fUnA) . ((âyâsnd(z). fst(y) â fst(z)) ⧠(âyâfst(z). âuâsnd(z). y=fst(u)))})" (is "M(?T)")
using assms(3) by simp
then
have 1:"M({â¨fst(z),map_snd(snd(z))â© . zâ?T})" (is "M(?Y)")
using lam_replacement_product[OF lam_replacement_fst
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_RepFun_snd]]
RepFun_closed lam_replacement_imp_strong_replacement
f_closed[OF transM[OF _ â¹M(?T)âº]]
by simp
have 2:"?Y = {â¨x,{f(y) . yâx}â© . xâA}" (is "_ = ?R")
proof(intro equalityI subsetI)
fix p
assume "pâ?R"
with â¹M(A)âº
obtain x where "xâA" "p=â¨x,{f(y) . y â x}â©" "M(x)"
using transM[OF _ â¹M(A)âº]
by auto
moreover from calculation
have "M({â¨y,f(y)â© . yâx})" (is "M(?Ux)")
using lam_replacement_iff_lam_closed assms
unfolding lam_def by auto
moreover from calculation
have "?Ux â ?fUnA"
by auto
moreover from calculation
have "?Ux â Pow_rel(M,?fUnA)"
using Pow_rel_char[OF â¹M(?fUnA)âº] by simp
moreover from calculation
have "âuâx. âwâ?Ux. u=fst(w)"
by force
moreover from calculation
have "â¨x,?Uxâ© â ?T" by auto
moreover from calculation
have "{f(y).yâx} = map_snd(?Ux)"
unfolding map_snd_def
by(intro equalityI,auto)
ultimately
show "pâ?Y"
by (auto,rule_tac bexI[where x=x],simp_all,rule_tac bexI[where x="?Ux"],simp_all)
next
fix u
assume "uâ?Y"
moreover from this
obtain z where "zâ?T" "u=â¨fst(z),map_snd(snd(z))â©"
by blast
moreover from calculation
obtain x U where
1:"xâA" "UâPow_rel(M,?fUnA)" "(âuâU. fst(u) â x) ⧠(âwâx. âvâU. w=fst(v))" "z=â¨x,Uâ©"
by force
moreover from this
have "fst(u)ââA" "snd(u) = f(fst(u))" if "uâU" for u
using that Pow_rel_char[OF â¹M(?fUnA)âº]
by auto
moreover from calculation
have "map_snd(U) = {f(y) . yâx}"
unfolding map_snd_def
by(intro equalityI subsetI,auto)
moreover from calculation
have "u=â¨x,map_snd(U)â©"
by simp
ultimately
show "uâ?R"
by (auto)
qed
from 1 2
have "M({â¨x,{f(y) . yâx}â© . xâA})"
by simp
}
then
have "âA[M]. M(λxâA. {f(y) . yâx})"
unfolding lam_def by auto
then
show ?thesis
using lam_replacement_iff_lam_closed[THEN iffD2] p_closed
by simp
qed
lemma lam_replacement_apply:"M(S) ⹠lam_replacement(M, λx. S ` x)"
using lam_replacement_Union lam_replacement_constant lam_replacement_identity
lam_replacement_Image lam_replacement_cons
lam_replacement_hcomp2[of _ _ Image] lam_replacement_hcomp2[of "λx. x" "λ_. 0" cons]
unfolding apply_def
by (rule_tac lam_replacement_hcomp[of _ Union]) (force intro:lam_replacement_hcomp)+
lemma apply_replacement:"M(S) ⹠strong_replacement(M, λx y. y = S ` x)"
using lam_replacement_apply lam_replacement_imp_strong_replacement by simp
lemma lam_replacement_id_const: "M(b) â¹ lam_replacement(M, λx. â¨x, bâ©)"
using lam_replacement_identity lam_replacement_constant
lam_replacement_product[of "λx. x" "λx. b"] by simp
lemmas pospend_replacement = lam_replacement_id_const[unfolded lam_replacement_def]
lemma lam_replacement_const_id: "M(b) â¹ lam_replacement(M, λz. â¨b, zâ©)"
using lam_replacement_identity lam_replacement_constant
lam_replacement_product[of "λx. b" "λx. x"] by simp
lemmas prepend_replacement = lam_replacement_const_id[unfolded lam_replacement_def]
lemma lam_replacement_apply_const_id: "M(f) â¹ M(z) â¹
lam_replacement(M, λx. f ` â¨z, xâ©)"
using lam_replacement_const_id[of z] lam_replacement_apply[of f]
lam_replacement_hcomp[of "λx. â¨z, xâ©" "λx. f`x"] by simp
lemmas apply_replacement2 = lam_replacement_apply_const_id[unfolded lam_replacement_def]
lemma lam_replacement_Inl: "lam_replacement(M, Inl)"
using lam_replacement_identity lam_replacement_constant
lam_replacement_product[of "λx. 0" "λx. x"]
unfolding Inl_def by simp
lemma lam_replacement_Inr: "lam_replacement(M, Inr)"
using lam_replacement_identity lam_replacement_constant
lam_replacement_product[of "λx. 1" "λx. x"]
unfolding Inr_def by simp
lemmas Inl_replacement1 = lam_replacement_Inl[unfolded lam_replacement_def]
lemma lam_replacement_Diff': "M(X) ⹠lam_replacement(M, λx. x - X)"
using lam_replacement_Diff
by (force intro: lam_replacement_hcomp2 lam_replacement_constant
lam_replacement_identity)+
lemmas Pair_diff_replacement = lam_replacement_Diff'[unfolded lam_replacement_def]
lemma diff_Pair_replacement: "M(p) â¹ strong_replacement(M, λx y . y=â¨x,x-{p}â©)"
using Pair_diff_replacement by simp
lemma swap_replacement:"strong_replacement(M, λx y. y = â¨x, (λâ¨x,yâ©. â¨y, xâ©)(x)â©)"
using lam_replacement_swap unfolding lam_replacement_def split_def by simp
lemma lam_replacement_Un_const:"M(b) ⹠lam_replacement(M, λx. x ⪠b)"
using lam_replacement_Un lam_replacement_hcomp2[of _ _ "(âª)"]
lam_replacement_constant[of b] lam_replacement_identity by simp
lemmas tag_union_replacement = lam_replacement_Un_const[unfolded lam_replacement_def]
lemma lam_replacement_csquare: "lam_replacement(M,λp. â¨fst(p) ⪠snd(p), fst(p), snd(p)â©)"
using lam_replacement_Un lam_replacement_fst lam_replacement_snd
by (fast intro: lam_replacement_product lam_replacement_hcomp2)
lemma csquare_lam_replacement:"strong_replacement(M, λx y. y = â¨x, (λâ¨x,yâ©. â¨x ⪠y, x, yâ©)(x)â©)"
using lam_replacement_csquare unfolding split_def lam_replacement_def .
lemma lam_replacement_assoc:"lam_replacement(M,λx. â¨fst(fst(x)), snd(fst(x)), snd(x)â©)"
using lam_replacement_fst lam_replacement_snd
by (force intro: lam_replacement_product lam_replacement_hcomp)
lemma assoc_replacement:"strong_replacement(M, λx y. y = â¨x, (λâ¨â¨x,yâ©,zâ©. â¨x, y, zâ©)(x)â©)"
using lam_replacement_assoc unfolding split_def lam_replacement_def .
lemma lam_replacement_prod_fun: "M(f) â¹ M(g) â¹ lam_replacement(M,λx. â¨f ` fst(x), g ` snd(x)â©)"
using lam_replacement_fst lam_replacement_snd
by (force intro: lam_replacement_product lam_replacement_hcomp lam_replacement_apply)
lemma prod_fun_replacement:"M(f) â¹ M(g) â¹
strong_replacement(M, λx y. y = â¨x, (λâ¨w,yâ©. â¨f ` w, g ` yâ©)(x)â©)"
using lam_replacement_prod_fun unfolding split_def lam_replacement_def .
lemma lam_replacement_vimage_sing: "lam_replacement(M, λp. fst(p) -`` {snd(p)})"
using lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_sing]
lam_replacement_hcomp2[OF lam_replacement_fst _ _ _ lam_replacement_vimage]
by simp
lemma lam_replacement_vimage_sing_fun: "M(f) ⹠lam_replacement(M, λx. f -`` {x})"
using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
lam_replacement_identity _ _ lam_replacement_vimage_sing]
by simp
lemma lam_replacement_image_sing_fun: "M(f) ⹠lam_replacement(M, λx. f `` {x})"
using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
lam_replacement_hcomp[OF lam_replacement_identity lam_replacement_sing]
_ _ lam_replacement_Image]
by simp
lemma converse_apply_projs: "âx[M]. â (fst(x) -`` {snd(x)}) = converse(fst(x)) ` (snd(x))"
using converse_apply_eq by auto
lemma lam_replacement_converse_app: "lam_replacement(M, λp. converse(fst(p)) ` snd(p))"
using lam_replacement_cong[OF _ converse_apply_projs]
lam_replacement_hcomp[OF lam_replacement_vimage_sing lam_replacement_Union]
by simp
lemmas cardinal_lib_assms4 = lam_replacement_vimage_sing_fun[unfolded lam_replacement_def]
lemma lam_replacement_sing_const_id:
"M(x) â¹ lam_replacement(M, λy. {â¨x, yâ©})"
using lam_replacement_hcomp[OF lam_replacement_const_id[of x]]
lam_replacement_sing pair_in_M_iff
by simp
lemma tag_singleton_closed: "M(x) â¹ M(z) â¹ M({{â¨z, yâ©} . y â x})"
using RepFun_closed[where A=x and f="λ u. {â¨z,uâ©}"]
lam_replacement_imp_strong_replacement lam_replacement_sing_const_id
transM[of _ x]
by simp
lemma separation_eq:
assumes "âx[M]. M(f(x))" "lam_replacement(M,f)"
"âx[M]. M(g(x))" "lam_replacement(M,g)"
shows "separation(M,λx . f(x) = g(x))"
proof -
let ?Z="λA. {â¨x,â¨f(x),â¨g(x),xâ©â©â©. xâA}"
let ?Y="λA. {â¨â¨x,f(x)â©,â¨g(x),xâ©â©. xâA}"
note sndsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd]
note fstsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_fst]
note sndfst = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
have "M(?Z(A))" if "M(A)" for A
using assms lam_replacement_iff_lam_closed that
lam_replacement_product[OF assms(2)
lam_replacement_product[OF assms(4) lam_replacement_identity]]
unfolding lam_def
by auto
moreover
have "?Y(A) = {â¨â¨fst(x), fst(snd(x))â©, fst(snd(snd(x))), snd(snd(snd(x)))â© . x â ?Z(A)}" for A
by auto
moreover from calculation
have "M(?Y(A))" if "M(A)" for A
using
lam_replacement_imp_strong_replacement[OF
lam_replacement_product[OF
lam_replacement_product[OF lam_replacement_fst fstsnd]
lam_replacement_product[OF
lam_replacement_hcomp[OF sndsnd lam_replacement_fst]
lam_replacement_hcomp[OF lam_replacement_snd sndsnd]
]
], THEN RepFun_closed,simplified,of "?Z(A)"]
fst_closed[OF transM] snd_closed[OF transM] that
by auto
then
have "M({uâ?Y(A) . snd(fst(u)) = fst(snd(u))})" (is "M(?W(A))") if "M(A)" for A
using that middle_separation assms
by auto
then
have "M({fst(fst(u)) . u â ?W(A)})" if "M(A)" for A
using that lam_replacement_imp_strong_replacement[OF
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst], THEN RepFun_closed]
fst_closed[OF transM]
by auto
moreover
have "{xâA. f(x) = g(x)} = {fst(fst(u)) . uâ?W(A)}" for A
by auto
ultimately
show ?thesis
using separation_iff by auto
qed
lemma separation_subset:
assumes "âx[M]. M(f(x))" "lam_replacement(M,f)"
"âx[M]. M(g(x))" "lam_replacement(M,g)"
shows "separation(M,λx . f(x) â g(x))"
proof -
have "f(x) â g(x) â· f(x)âªg(x) = g(x)" for x
using subset_Un_iff by simp
moreover from assms
have "separation(M,λx . f(x)âªg(x) = g(x))"
using separation_eq lam_replacement_Un lam_replacement_hcomp2
by simp
ultimately
show ?thesis
using separation_cong[THEN iffD1] by auto
qed
lemma separation_ball:
assumes "separation(M, λy. f(fst(y),snd(y)))" "M(X)"
shows "separation(M, λy. âuâX. f(y,u))"
unfolding separation_def
proof(clarify)
fix A
assume "M(A)"
moreover
note â¹M(X)âº
moreover from calculation
have "M(AÃX)"
by simp
then
have "M({p â AÃX . f(fst(p),snd(p))})" (is "M(?P)")
using assms(1)
by auto
moreover from calculation
have "M({aâA . ?P``{a} = X})" (is "M(?A')")
using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
by simp
moreover
have "f(a,x)" if "aâ?A'" and "xâX" for a x
proof -
from that
have "aâA" "?P``{a}=X"
by auto
then
have "xâ?P``{a}"
using that by simp
then
show ?thesis using image_singleton_iff by simp
qed
moreover from this
have "âa[M]. a â ?A' â· a â A ⧠(âxâX. f(a, x))"
using image_singleton_iff
by auto
with â¹M(?A')âº
show "ây[M]. âa[M]. a â y â· a â A ⧠(âxâX. f(a, x))"
by (rule_tac x="?A'" in rexI,simp_all)
qed
lemma lam_replacement_twist: "lam_replacement(M,λâ¨â¨x,yâ©,zâ©. â¨x,y,zâ©)"
using lam_replacement_fst lam_replacement_snd
lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
of "λx. snd(fst(x))" "λx. snd(x)", THEN [2] lam_replacement_Pair[
THEN [5] lam_replacement_hcomp2, of "λx. fst(fst(x))"]]
lam_replacement_hcomp unfolding split_def by simp
lemma twist_closed[intro,simp]: "M(x) â¹ M((λâ¨â¨x,yâ©,zâ©. â¨x,y,zâ©)(x))"
unfolding split_def by simp
lemma lam_replacement_Lambda:
assumes "lam_replacement(M, λy. b(fst(y), snd(y)))"
"âw[M]. ây[M]. M(b(w, y))" "M(W)"
shows "lam_replacement(M, λx. λwâW. b(x, w))"
proof (intro lam_replacement_iff_lam_closed[THEN iffD2]; clarify)
have aux_sep: "âx[M]. separation(M,λy. â¨fst(x), yâ© â A)"
if "M(X)" "M(A)" for X A
using separation_in lam_replacement_hcomp2[OF lam_replacement_hcomp[OF lam_replacement_constant lam_replacement_fst]
lam_replacement_identity _ _ lam_replacement_Pair]
lam_replacement_constant[of A]
that
by simp
have aux_closed: "âx[M]. M({y â X . â¨fst(x), yâ© â A})" if "M(X)" "M(A)" for X A
using aux_sep that by simp
have aux_lemma: "lam_replacement(M,λp . {y â X . â¨fst(p), yâ© â A})"
if "M(X)" "M(A)" for X A
proof -
note lr = lam_replacement_Collect[OF â¹M(X)âº]
note fst3 = lam_replacement_hcomp[OF lam_replacement_fst
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
then show ?thesis
using lam_replacement_Collect[OF â¹M(X)⺠aux_sep separation_ball[OF separation_iff']]
separation_in[OF _ lam_replacement_snd _ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]
separation_in[OF _ lam_replacement_hcomp2[OF fst3 lam_replacement_snd _ _ lam_replacement_Pair] _
lam_replacement_constant[of A]] that
by auto
qed
from assms
show lbc:"M(x) â¹ M(λwâW. b(x, w))" for x
using lam_replacement_constant lam_replacement_identity
lam_replacement_hcomp2[where h=b]
by (intro lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
simp_all
fix A
assume "M(A)"
moreover from this assms
have "M({b(fst(x),snd(x)). x â AÃW})" (is "M(?RFb)")
using lam_replacement_imp_strong_replacement transM[of _ "AÃW"]
by (rule_tac RepFun_closed) auto
moreover
have "{â¨â¨x,yâ©,zâ© â (AÃW)Ã?RFb. z = b(x,y)} = (λâ¨x,yâ©âAÃW. b(x,y)) â© (AÃW)Ã?RFb"
(is "{â¨â¨x,yâ©,zâ© â (AÃW)Ã?B. _ } = ?lam")
unfolding lam_def by auto
moreover from calculation and assms
have "M(?lam)"
using lam_replacement_iff_lam_closed unfolding split_def by simp
moreover
have "{â¨â¨x,yâ©,zâ© â (X à Y) à Z . P(x, y, z)} â (X à Y) à Z" for X Y Z P
by auto
then
have "{â¨x,y,zâ© â XÃYÃZ. P(x,y,z) }= (λâ¨â¨x,yâ©,zâ©â(XÃY)ÃZ. â¨x,y,zâ©) ``
{â¨â¨x,yâ©,zâ© â (XÃY)ÃZ. P(x,y,z) }" (is "?C' = Lambda(?A,?f) `` ?C")
for X Y Z P
using image_lam[of ?C ?A ?f]
by (intro equalityI) (auto)
with calculation
have "{â¨x,y,zâ© â AÃWÃ?RFb. z = b(x,y) } =
(λâ¨â¨x,yâ©,zâ©â(AÃW)Ã?RFb. â¨x,y,zâ©) `` ?lam" (is "?H = ?G ")
by simp
with â¹M(A)⺠â¹M(W)⺠â¹M(?lam)⺠â¹M(?RFb)âº
have "M(?H)"
using lam_replacement_iff_lam_closed[THEN iffD1, rule_format, OF _ lam_replacement_twist]
by simp
moreover from this and â¹M(A)âº
have "(λxâA. λwâW. b(x, w)) =
{â¨x,Zâ© â A à PowâMâ(range(?H)). Z = {y â WÃ?RFb . â¨x, yâ© â ?H}}"
unfolding lam_def
by (intro equalityI; subst Pow_rel_char[of "range(?H)"])
(auto dest:transM simp: lbc[unfolded lam_def], force+)
moreover from calculation and â¹M(A)⺠and â¹M(W)âº
have "M(AÃPowâMâ(range(?H)))" "M(WÃ?RFb)"
by auto
moreover
note â¹M(W)âº
moreover from calculation
have "M({â¨x,Zâ© â A à PowâMâ(range(?H)). Z = {y â WÃ?RFb . â¨x, yâ© â ?H}})"
using separation_eq[OF _ lam_replacement_snd
aux_closed[OF â¹M(WÃ?RFb)⺠â¹M(?H)âº]
aux_lemma[OF â¹M(WÃ?RFb)⺠â¹M(?H)âº]]
â¹M(AÃPowâMâ(_))⺠assms
unfolding split_def
by auto
ultimately
show "M(λxâA. λwâW. b(x, w))" by simp
qed
lemma lam_replacement_apply_Pair:
assumes "M(y)"
shows "lam_replacement(M, λx. y ` â¨fst(x), snd(x)â©)"
using assms lam_replacement_constant lam_replacement_Pair
lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
by auto
lemma lam_replacement_apply_fst_snd:
shows "lam_replacement(M, λw. fst(w) ` fst(snd(w)) ` snd(snd(w)))"
using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
by auto
lemma separation_snd_in_fst: "separation(M, λx. snd(x) â fst(x))"
using separation_in lam_replacement_fst lam_replacement_snd
by auto
lemma lam_replacement_if_mem:
"lam_replacement(M, λx. if snd(x) â fst(x) then 1 else 0)"
using separation_snd_in_fst
lam_replacement_constant lam_replacement_if
by auto
lemma lam_replacement_Lambda_apply_fst_snd:
assumes "M(X)"
shows "lam_replacement(M, λx. λwâX. x ` fst(w) ` snd(w))"
using assms lam_replacement_apply_fst_snd lam_replacement_Lambda
by simp
lemma lam_replacement_Lambda_apply_Pair:
assumes "M(X)" "M(y)"
shows "lam_replacement(M, λx. λwâX. y ` â¨x, wâ©)"
using assms lam_replacement_apply_Pair lam_replacement_Lambda
by simp
lemma lam_replacement_Lambda_if_mem:
assumes "M(X)"
shows "lam_replacement(M, λx. λxaâX. if xa â x then 1 else 0)"
using assms lam_replacement_if_mem lam_replacement_Lambda
by simp
lemma lam_replacement_comp':
"M(f) ⹠M(g) ⹠lam_replacement(M, λx . f O x O g)"
using lam_replacement_comp[THEN [5] lam_replacement_hcomp2,
OF lam_replacement_constant lam_replacement_comp,
THEN [5] lam_replacement_hcomp2] lam_replacement_constant
lam_replacement_identity by simp
lemma separation_bex:
assumes "separation(M, λy. f(fst(y),snd(y)))" "M(X)"
shows "separation(M, λy. âuâX. f(y,u))"
unfolding separation_def
proof(clarify)
fix A
assume "M(A)"
moreover
note â¹M(X)âº
moreover from calculation
have "M(AÃX)"
by simp
then
have "M({p â AÃX . f(fst(p),snd(p))})" (is "M(?P)")
using assms(1)
by auto
moreover from calculation
have "M({aâA . ?P``{a} â 0})" (is "M(?A')")
using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
separation_neg
by simp
moreover from this
have "âa[M]. a â ?A' â· a â A ⧠(âxâX. f(a, x))"
using image_singleton_iff
by auto
with â¹M(?A')âº
show "ây[M]. âa[M]. a â y â· a â A ⧠(âxâX. f(a, x))"
by (rule_tac x="?A'" in rexI,simp_all)
qed
lemma case_closed :
assumes "âx[M]. M(f(x))" "âx[M]. M(g(x))"
shows "âx[M]. M(case(f,g,x))"
unfolding case_def split_def cond_def
using assms by simp
lemma separation_fst_equal : "M(a) ⹠separation(M,λx . fst(x)=a)"
using separation_eq lam_replacement_fst lam_replacement_constant
by auto
lemma lam_replacement_case :
assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
"âx[M]. M(f(x))" "âx[M]. M(g(x))"
shows "lam_replacement(M, λx . case(f,g,x))"
unfolding case_def split_def cond_def
using lam_replacement_if separation_fst_equal
lam_replacement_hcomp[of "snd" g]
lam_replacement_hcomp[of "snd" f]
lam_replacement_snd assms
by simp
lemma Pi_replacement1: "M(x) â¹ M(y) â¹ strong_replacement(M, λya z. ya â y ⧠z = {â¨x, yaâ©})"
using lam_replacement_imp_strong_replacement
strong_replacement_separation[OF lam_replacement_sing_const_id[of x],where P="λx . x ây"]
separation_in_constant
by simp
lemma surj_imp_inj_replacement1:
"M(f) â¹ M(x) â¹ strong_replacement(M, λy z. y â f -`` {x} ⧠z = {â¨x, yâ©})"
using Pi_replacement1 vimage_closed singleton_closed
by simp
lemmas domain_replacement = lam_replacement_domain[unfolded lam_replacement_def]
lemma domain_replacement_simp: "strong_replacement(M, λx y. y=domain(x))"
using lam_replacement_domain lam_replacement_imp_strong_replacement by simp
lemma un_Pair_replacement: "M(p) â¹ strong_replacement(M, λx y . y = xâª{p})"
using lam_replacement_Un_const[THEN lam_replacement_imp_strong_replacement] by simp
lemma diff_replacement: "M(X) ⹠strong_replacement(M, λx y. y = x - X)"
using lam_replacement_Diff'[THEN lam_replacement_imp_strong_replacement] by simp
lemma lam_replacement_succ:
"lam_replacement(M,λz . succ(z))"
unfolding succ_def
using lam_replacement_hcomp2[of "λx. x" "λx. x" cons]
lam_replacement_cons lam_replacement_identity
by simp
lemma lam_replacement_hcomp_Least:
assumes "lam_replacement(M, g)" "lam_replacement(M,λx. μ i. xâF(i,x))"
"âx[M]. M(g(x))" "âx i. M(x) â¹ i â F(i, x) â¹ M(i)"
shows "lam_replacement(M,λx. μ i. g(x)âF(i,g(x)))"
using assms
by (rule_tac lam_replacement_hcomp[of _ "λx. μ i. xâF(i,x)"])
(auto intro:Least_closed')
lemma domain_mem_separation: "M(A) â¹ separation(M, λx . domain(x)âA)"
using separation_in lam_replacement_constant lam_replacement_domain
by auto
lemma domain_eq_separation: "M(p) ⹠separation(M, λx . domain(x) = p)"
using separation_eq lam_replacement_domain lam_replacement_constant
by auto
lemma lam_replacement_Int:
shows "lam_replacement(M, λx. fst(x) ⩠snd(x))"
proof -
have "Aâ©B = (AâªB) - ((A- B) ⪠(B-A))" (is "_=?f(A,B)")for A B
by auto
then
show ?thesis
using lam_replacement_cong
lam_replacement_Diff[THEN[5] lam_replacement_hcomp2]
lam_replacement_Un[THEN[5] lam_replacement_hcomp2]
lam_replacement_fst lam_replacement_snd
by simp
qed
lemma lam_replacement_CartProd:
assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
"âx[M]. M(f(x))" "âx[M]. M(g(x))"
shows "lam_replacement(M, λx. f(x) à g(x))"
proof -
note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
{
fix A
assume "M(A)"
moreover
note transM[OF _ â¹M(A)âº]
moreover from calculation assms
have "M({â¨x,â¨f(x),g(x)â©â© . xâA})" (is "M(?A')")
using lam_replacement_product[THEN lam_replacement_imp_lam_closed[unfolded lam_def]]
by simp
moreover from calculation
have "M(â{f(x) . xâA})" (is "M(?F)")
using rep_closed[OF assms(1)] assms(3)
by simp
moreover from calculation
have "M(â{g(x) . xâA})" (is "M(?G)")
using rep_closed[OF assms(2)] assms(4)
by simp
moreover from calculation
have "M(?A' Ã (?F Ã ?G))" (is "M(?T)")
by simp
moreover from this
have "M({t â ?T . fst(snd(t)) â fst(snd(fst(t))) ⧠snd(snd(t)) â snd(snd(fst(t)))})" (is "M(?Q)")
using
lam_replacement_hcomp[OF lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ ]
lam_replacement_hcomp lam_replacement_identity lam_replacement_fst lam_replacement_snd
separation_in separation_conj
by simp
moreover from this
have "M({â¨fst(fst(t)),snd(t)â© . tâ?Q})" (is "M(?R)")
using rep_closed lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst] lam_replacement_snd
transM[of _ ?Q]
by simp
moreover from calculation
have "M({â¨x,?R``{x}â© . xâA})"
using lam_replacement_imp_lam_closed[unfolded lam_def] lam_replacement_sing
lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of ?R]
by simp
moreover
have "?R``{x} = f(x)Ãg(x)" if "xâA" for x
by(rule equalityI subsetI,force,rule subsetI,rule_tac a="x" in imageI)
(auto simp:that,(rule_tac rev_bexI[of x],simp_all add:that)+)
ultimately
have "M({â¨x,f(x) à g(x)â© . xâA})" by auto
}
with assms
show ?thesis using lam_replacement_iff_lam_closed[THEN iffD2,unfolded lam_def]
by simp
qed
lemma restrict_eq_separation': "M(B) â¹ âA[M]. separation(M, λy. âxâA. y = â¨x, restrict(x, B)â©)"
proof(clarify)
fix A
have "restrict(r,B) = r â© (B Ã range(r))" for r
unfolding restrict_def by(rule equalityI subsetI,auto)
moreover
assume "M(A)" "M(B)"
moreover from this
have "separation(M, λy. âxâA. y = â¨x, x â© (B à range(x))â©)"
using lam_replacement_Int[THEN[5] lam_replacement_hcomp2]
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
using lam_replacement_fst lam_replacement_snd lam_replacement_constant
lam_replacement_hcomp lam_replacement_range lam_replacement_identity
lam_replacement_CartProd separation_bex separation_eq
by simp_all
ultimately
show "separation(M, λy. âxâA. y = â¨x, restrict(x, B)â©)"
by simp
qed
lemmas lam_replacement_restrict' = lam_replacement_restrict[OF restrict_eq_separation']
lemma restrict_strong_replacement: "M(A) ⹠strong_replacement(M, λx y. y=restrict(x,A))"
using lam_replacement_restrict restrict_eq_separation'
lam_replacement_imp_strong_replacement
by simp
lemma restrict_eq_separation: "M(r) ⹠M(p) ⹠separation(M, λx . restrict(x,r) = p)"
using separation_eq lam_replacement_restrict' lam_replacement_constant
by auto
lemma separation_equal_fst2 : "M(a) ⹠separation(M,λx . fst(fst(x))=a)"
using separation_eq lam_replacement_hcomp lam_replacement_fst lam_replacement_constant
by auto
lemma separation_equal_apply: "M(f) ⹠M(a) ⹠separation(M,λx. f`x=a)"
using separation_eq lam_replacement_apply[of f] lam_replacement_constant
by auto
lemma lam_apply_replacement: "M(A) â¹ M(f) â¹ lam_replacement(M, λx . λnâA. f ` â¨x, nâ©)"
using lam_replacement_Lambda lam_replacement_hcomp[OF _ lam_replacement_apply[of f]] lam_replacement_Pair
by simp
lemma separation_all:
assumes "separation(M, λx .P(fst(x),snd(x)))"
shows "separation(M, λz. âxâz. P(z,x))"
unfolding separation_def
proof(clarify)
fix A
assume "M(A)"
let ?B="âA"
let ?C="AÃ?B"
note â¹M(A)âº
moreover from calculation
have "M(?C)"
by simp
moreover from calculation
have "M({pâ?C . P(fst(p),snd(p)) ⧠snd(p)âfst(p)})" (is "M(?Prod)")
using assms separation_conj separation_in lam_replacement_fst lam_replacement_snd
by simp
moreover from calculation
have "M({zâA . z=?Prod``{z}})" (is "M(?L)")
using separation_eq lam_replacement_identity
lam_replacement_constant[of ?Prod] lam_replacement_image_sing_fun
by simp
moreover
have "?L = {zâA . âxâz. P(z,x)}"
proof -
have "P(z,x)" if "zâA" "xâz" "xâ?Prod``{z}" for z x
using that
by auto
moreover
have "z = ?Prod `` {z}" if "zâA" "âxâz. P(z, x)" for z
using that
by(intro equalityI subsetI,auto)
ultimately
show ?thesis
by(intro equalityI subsetI,auto)
qed
ultimately
show " ây[M]. âz[M]. z â y â· z â A ⧠(âxâz . P(z,x))"
by (rule_tac x="?L" in rexI,simp_all)
qed
lemma separation_Transset: "separation(M,Transset)"
unfolding Transset_def
using separation_all separation_subset lam_replacement_fst lam_replacement_snd
by auto
lemma separation_comp :
assumes "separation(M,P)" "lam_replacement(M,f)" "âx[M]. M(f(x))"
shows "separation(M,λx. P(f(x)))"
unfolding separation_def
proof(clarify)
fix A
assume "M(A)"
let ?B="{f(a) . a â A}"
let ?C="AÃ{bâ?B . P(b)}"
note â¹M(A)âº
moreover from calculation
have "M(?C)"
using lam_replacement_imp_strong_replacement assms RepFun_closed transM[of _ A]
by simp
moreover from calculation
have "M({pâ?C . f(fst(p)) = snd(p)})" (is "M(?Prod)")
using assms separation_eq lam_replacement_fst lam_replacement_snd
lam_replacement_hcomp
by simp
moreover from calculation
have "M({fst(p) . pâ?Prod})" (is "M(?L)")
using lam_replacement_imp_strong_replacement lam_replacement_fst RepFun_closed
transM[of _ ?Prod]
by simp
moreover
have "?L = {zâA . P(f(z))}"
by(intro equalityI subsetI,auto)
ultimately
show " ây[M]. âz[M]. z â y â· z â A ⧠P(f(z))"
by (rule_tac x="?L" in rexI,simp_all)
qed
lemma separation_Ord: "separation(M,Ord)"
unfolding Ord_def
using separation_conj separation_Transset separation_all
separation_comp separation_Transset lam_replacement_snd
by auto
end
= M_replacement +
assumes
:"lam_replacement(M, λp. minimum(fst(p),snd(p)))"
and
:"lam_replacement(M, λp. RepFun(fst(p), λx. {â¨snd(p),xâ©}))"
begin
lemma :
assumes "lam_replacement(M,f)" "ây[M]. M(f(y))"
shows "lam_replacement(M, λx. Sigfun(x,f))"
using lam_replacement_Union lam_replacement_identity
lam_replacement_sing[THEN lam_replacement_imp_strong_replacement]
lam_replacement_hcomp[of _ Union] assms tag_singleton_closed
lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2]
unfolding Sigfun_def
by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
subsectionâ¹Particular instancesâº
lemma :
"M(f) ⹠strong_replacement(M, λx z. z = Sigfun(x, λy. f -`` {y}))"
using lam_replacement_imp_strong_replacement lam_replacement_Sigfun
lam_replacement_vimage_sing_fun
by simp
lemma :
"M(f) ⹠M(r) ⹠lam_replacement(M, λx. minimum(r, f -`` {x}))"
using lam_replacement_minimum lam_replacement_vimage_sing_fun lam_replacement_constant
by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
(force intro: lam_replacement_identity)+
lemmas = lam_replacement_minimum_vimage[unfolded lam_replacement_def]
lemma : "M(y) â¹ lam_replacement(M, λx. âxaây. {â¨x, xaâ©})"
using lam_replacement_Union lam_replacement_identity lam_replacement_constant
lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2] tag_singleton_closed
by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
lemma : "M(y) â¹ strong_replacement(M, λx z. z = (âxaây. {â¨x, xaâ©}))"
using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
proof -
assume "M(y)"
then
have "M(x) â¹ M(âxaây. {â¨x, xaâ©})" for x
using tag_singleton_closed
by (rule_tac Union_closed RepFun_closed)
with â¹M(y)âº
show ?thesis
using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
by blast
qed
lemma :
shows "M(A) â¹ strong_replacement(M, λx y. y = â¨x, if x â A then Inl(x) else Inr(x)â©)"
using lam_replacement_if lam_replacement_Inl lam_replacement_Inr separation_in_constant
unfolding lam_replacement_def
by simp
lemma :
"M(b) â¹
M(a) â¹ M(f) â¹ strong_replacement(M, λy ya. ya = â¨y, if y = a then b else f ` yâ©)"
using lam_replacement_if lam_replacement_apply lam_replacement_constant
separation_equal
unfolding lam_replacement_def
by simp
lemma :
"M(A) â¹ M(f) â¹ M(g) â¹ strong_replacement(M, λx y. y = â¨x, if x â A then f ` x else g ` xâ©)"
using lam_replacement_if lam_replacement_apply[of f] lam_replacement_apply[of g]
separation_in_constant
unfolding lam_replacement_def
by simp
lemma :
"M(f) â¹
M(b) â¹ strong_replacement(M, λx y. y = â¨x, if x â range(f) then converse(f) ` x else bâ©)"
using lam_replacement_if lam_replacement_apply lam_replacement_constant
separation_in_constant
unfolding lam_replacement_def
by simp
lemma :
"M(A) â¹ M(C) â¹ strong_replacement(M, λx y. y = â¨x, if x = Inl(A) then C else xâ©)"
using lam_replacement_if lam_replacement_constant lam_replacement_identity
separation_equal
unfolding lam_replacement_def
by simp
lemma :
"M(u) â¹
M(f) â¹
strong_replacement
(M,
λz y. y = â¨z, if z = u then f ` 0 else if z â range(f) then f ` succ(converse(f) ` z) else zâ©)"
using lam_replacement_if separation_equal separation_in_constant
lam_replacement_constant lam_replacement_identity
lam_replacement_succ lam_replacement_apply
lam_replacement_hcomp[of "λx. converse(f)`x" "succ"]
lam_replacement_hcomp[of "λx. succ(converse(f)`x)" "λx . f`x"]
unfolding lam_replacement_def
by simp
lemma :
"M(A) â¹
strong_replacement(M, λx y. y = â¨x, if fst(x) = A then Inl(snd(x)) else Inr(x)â©)"
using lam_replacement_if separation_fst_equal
lam_replacement_hcomp[of "snd" "Inl"]
lam_replacement_Inl lam_replacement_Inr lam_replacement_snd
unfolding lam_replacement_def
by simp
lemma :
"strong_replacement(M, λz y. y = â¨z, case(Inr, Inl, z)â©)"
using lam_replacement_case lam_replacement_Inl lam_replacement_Inr
unfolding lam_replacement_def
by simp
lemma :
"strong_replacement(M, λz y. y = â¨z, case(case(Inl, λy. Inr(Inl(y))), λy. Inr(Inr(y)), z)â©)"
using lam_replacement_case lam_replacement_hcomp
case_closed[of Inl "λx. Inr(Inl(x))"]
lam_replacement_Inl lam_replacement_Inr
unfolding lam_replacement_def
by simp
lemma :
"M(f) â¹ M(g) â¹ strong_replacement(M, λz y. y = â¨z, case(λw. Inl(f ` w), λy. Inr(g ` y), z)â©)"
using lam_replacement_case lam_replacement_hcomp
lam_replacement_Inl lam_replacement_Inr lam_replacement_apply
unfolding lam_replacement_def
by simp
lemma :
"strong_replacement(M, λx y. y = â¨x, (λâ¨x,zâ©. case(λy. Inl(â¨y, zâ©), λy. Inr(â¨y, zâ©), x))(x)â©)"
unfolding split_def case_def cond_def
using lam_replacement_if separation_equal_fst2
lam_replacement_snd lam_replacement_Inl lam_replacement_Inr
lam_replacement_hcomp[OF
lam_replacement_product[OF
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]]
unfolding lam_replacement_def
by simp
end
definition
dC_F :: "i â i â i" where
"dC_F(A,d) â¡ {p â A. domain(p) = d }"
definition
drSR_Y :: "i â i â i â i â i" where
"drSR_Y(B,D,A,x) â¡ {y . râA , restrict(r,B) = x ⧠y = domain(r) ⧠domain(r) â D}"
lemma drSR_Y_equality: "drSR_Y(B,D,A,x) = { drâD . (ârâA . restrict(r,B) = x ⧠dr=domain(r)) }"
unfolding drSR_Y_def by auto
context M_replacement_extra
begin
lemma :"âx[M].separation(M, λdr. ârâA . restrict(r,B) = x ⧠dr=domain(r))"
if "M(A)" and "M(B)" for A B
using that
separation_eq[OF _
lam_replacement_fst _
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain ]]
separation_eq[OF _
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict'] _
lam_replacement_constant]
by(clarify,rule_tac separation_bex[OF _ â¹M(A)âº],rule_tac separation_conj,simp_all)
lemma : "separation(M, λp. âxâD. x â snd(p) â· (ârâA. restrict(r, B) = fst(p) ⧠x = domain(r)))"
if "M(B)" "M(D)" "M(A)" for A B D
using that lam_replacement_fst lam_replacement_hcomp lam_replacement_snd separation_in
separation_eq[OF _
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain]]
separation_eq separation_restrict_eq_dom_eq
lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
lam_replacement_hcomp[OF lam_replacement_fst
lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
by(rule_tac separation_ball,rule_tac separation_iff',simp_all,
rule_tac separation_bex[OF _ â¹M(A)âº],rule_tac separation_conj,simp_all)
lemma :
assumes
"M(B)" "M(D)" "M(A)"
shows "lam_replacement(M, drSR_Y(B,D,A))"
using lam_replacement_cong lam_replacement_Collect[OF â¹M(D)⺠separation_restrict_eq_dom_eq[of A B]]
assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
by simp
lemma :
assumes
"M(B)" "M(D)" "M(A)" "M(f)"
shows "M(drSR_Y(B,D,A,f))"
using assms drSR_Y_equality lam_replacement_Collect[OF â¹M(D)⺠separation_restrict_eq_dom_eq[of A B]]
assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
by simp
lemma : "M(f) â¹ M(v) â¹ M(u) â¹
lam_replacement(M, λx. if f ` x = v then f ` u else f ` x)"
using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
by simp
lemma : "M(f) â¹ M(m) â¹ M(y) â¹
lam_replacement(M, λz . if f ` z = m then y else f ` z)"
using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
by simp
lemma : "M(A) â¹ M(f) â¹
lam_replacement(M, λx . if x â A then f ` x else x)"
using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
by simp
lemma : "M(G) ⹠lam_replacement(M, λx. if M(x) then G ` x else 0)"
using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
lam_replacement_constant[of 0] separation_univ
by simp
lemma :
assumes "M(A)"
shows "lam_replacement(M, dC_F(A))"
proof -
have "separation(M, λp. âxâA. x â snd(p) â· domain(x) = fst(p))" if "M(A)" for A
using separation_ball separation_iff'
lam_replacement_hcomp lam_replacement_fst lam_replacement_snd lam_replacement_domain
separation_in separation_eq that
by simp_all
then
show ?thesis
unfolding dC_F_def
using assms lam_replacement_Collect[of A "λ d x . domain(x) = d"]
separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
by simp
qed
lemma :
assumes "M(A)" "M(f)"
shows "M(dC_F(A,f))"
unfolding dC_F_def
using assms lam_replacement_Collect[of A "λ d x . domain(x) = d"]
separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
by simp
lemma : "M(f) ⹠M(r) ⹠lam_replacement(M, λx . minimum(r, f -`` {x}))"
using lam_replacement_hcomp2[OF lam_replacement_constant[of r] lam_replacement_vimage_sing_fun]
lam_replacement_minimum
by simp
lemma :
assumes "separation(M, λp. âxâG. x â snd(p) â· (âsâfst(p). â¨s, xâ© â Q))" "M(G)" "M(Q)"
shows "lam_replacement(M, λx . {a â G . âsâx. â¨s, aâ© â Q})"
proof -
have 1:"âx[M]. separation(M, λa . âsâx. â¨s, aâ© â Q)" if "M(Q)" for Q
using separation_in lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair]
lam_replacement_constant separation_ball
lam_replacement_hcomp lam_replacement_fst lam_replacement_snd that
by simp
then
show ?thesis
using assms lam_replacement_Collect
by simp_all
qed
lemma :
"(âx. M(x) â¹ separation(M, λy. âsâx. â¨s, yâ© â Q)) â¹ M(G) â¹ M(Q) â¹ M(x) â¹
strong_replacement(M, λy z. y â {a â G . âsâx. â¨s, aâ© â Q} ⧠z = {â¨x, yâ©})"
using lam_replacement_imp_strong_replacement
using lam_replacement_sing_const_id[THEN lam_replacement_imp_strong_replacement, of x]
unfolding strong_replacement_def
by (simp, safe, drule_tac x="A â© {a â G . âsâx. â¨s, aâ© â Q}" in rspec,
simp, erule_tac rexE, rule_tac x=Y in rexI) auto
lemmas = Pair_diff_replacement id_replacement tag_replacement
pospend_replacement prepend_replacement
Inl_replacement1 diff_Pair_replacement
swap_replacement tag_union_replacement csquare_lam_replacement
assoc_replacement prod_fun_replacement
cardinal_lib_assms4 domain_replacement
apply_replacement
un_Pair_replacement restrict_strong_replacement diff_replacement
if_then_Inj_replacement lam_if_then_replacement if_then_replacement
ifx_replacement if_then_range_replacement2 if_then_range_replacement
Inl_replacement2
case_replacement1 case_replacement2 case_replacement4 case_replacement5
end
end >
Theory Discipline_Cardinal
theory Discipline_Cardinal
imports
Discipline_Function
begin
declare [[syntax_ambiguity_warning = false]]
relativize functional "cardinal" "cardinal_rel" external
relationalize "cardinal_rel" "is_cardinal"
synthesize "is_cardinal" from_definition assuming "nonempty"
notation is_cardinal_fm (â¹cardinal'(_') is _âº)
abbreviation
cardinal_r :: "[i,iâo] â i" (â¹|_|â_ââº) where
"|x|âMâ â¡ cardinal_rel(M,x)"
abbreviation
cardinal_r_set :: "[i,i]âi" (â¹|_|â_ââº) where
"|x|âMâ â¡ cardinal_rel(##M,x)"
context M_trivial begin
rel_closed for "cardinal"
using Least_closed'[of "λi. M(i) ⧠i ââMâ A"]
unfolding cardinal_rel_def
by simp
end
manual_arity intermediate for "is_Int_fm"
unfolding is_Int_fm_def
using arity pred_Un_distrib
by (simp)
arity_theorem for "is_Int_fm"
arity_theorem for "is_funspace_fm"
arity_theorem for "is_function_space_fm"
arity_theorem for "surjP_rel_fm"
arity_theorem intermediate for "is_surj_fm"
lemma arity_is_surj_fm [arity] :
"A â nat â¹ B â nat â¹ I â nat â¹ arity(is_surj_fm(A, B, I)) = succ(A) ⪠succ(B) ⪠succ(I)"
using arity_is_surj_fm' pred_Un_distrib
by auto
arity_theorem for "injP_rel_fm"
arity_theorem intermediate for "is_inj_fm"
lemma arity_is_inj_fm [arity]:
"A â nat â¹ B â nat â¹ I â nat â¹ arity(is_inj_fm(A, B, I)) = succ(A) ⪠succ(B) ⪠succ(I)"
using arity_is_inj_fm' pred_Un_distrib
by auto
arity_theorem for "is_bij_fm"
arity_theorem for "is_eqpoll_fm"
arity_theorem for "is_cardinal_fm"
context M_Perm begin
is_iff_rel for "cardinal"
using least_abs'[of "λi. M(i) ⧠i ââMâ A"]
is_eqpoll_iff
unfolding is_cardinal_def cardinal_rel_def
by simp
end
reldb_add functional "Ord" "Ord"
reldb_add relational "Ord" "ordinal"
reldb_add functional "lt" "lt"
reldb_add relational "lt" "lt_rel"
synthesize "lt_rel" from_definition
notation lt_rel_fm (â¹â
_ < _â
âº)
arity_theorem intermediate for "lt_rel_fm"
lemma arity_lt_rel_fm[arity]: "a â nat â¹ b â nat â¹ arity(lt_rel_fm(a, b)) = succ(a) ⪠succ(b)"
using arity_lt_rel_fm'
by auto
relativize functional "Card" "Card_rel" external
relationalize "Card_rel" "is_Card"
synthesize "is_Card" from_definition assuming "nonempty"
notation is_Card_fm (â¹â
Card'(_')â
âº)
arity_theorem for "is_Card_fm"
notation Card_rel (â¹Cardâ_â'(_')âº)
lemma (in M_Perm) is_Card_iff: "M(A) â¹ is_Card(M, A) â· CardâMâ(A)"
using is_cardinal_iff
unfolding is_Card_def Card_rel_def by simp
abbreviation
Card_r_set :: "[i,i]âo" (â¹Cardâ_â'(_')âº) where
"CardâMâ(i) â¡ Card_rel(##M,i)"
relativize functional "InfCard" "InfCard_rel" external
relationalize "InfCard_rel" "is_InfCard"
synthesize "is_InfCard" from_definition assuming "nonempty"
notation is_InfCard_fm (â¹â
InfCard'(_')â
âº)
arity_theorem for "is_InfCard_fm"
notation InfCard_rel (â¹InfCardâ_â'(_')âº)
abbreviation
InfCard_r_set :: "[i,i]âo" (â¹InfCardâ_â'(_')âº) where
"InfCardâMâ(i) â¡ InfCard_rel(##M,i)"
relativize functional "cadd" "cadd_rel" external
abbreviation
cadd_r :: "[i,iâo,i] â i" (â¹_ ââ_â _⺠[66,1,66] 65) where
"A ââMâ B â¡ cadd_rel(M,A,B)"
context M_basic begin
rel_closed for "cadd"
using cardinal_rel_closed
unfolding cadd_rel_def
by simp
end
relationalize "cadd_rel" "is_cadd"
manual_schematic for "is_cadd" assuming "nonempty"
unfolding is_cadd_def
by (rule iff_sats sum_iff_sats | simp)+
synthesize "is_cadd" from_schematic
arity_theorem for "sum_fm"
arity_theorem for "is_cadd_fm"
context M_Perm begin
is_iff_rel for "cadd"
using is_cardinal_iff
unfolding is_cadd_def cadd_rel_def
by simp
end
relativize functional "cmult" "cmult_rel" external
abbreviation
cmult_r :: "[i,iâo,i] â i" (â¹_ ââ_â _⺠[66,1,66] 65) where
"A ââMâ B â¡ cmult_rel(M,A,B)"
relationalize "cmult_rel" "is_cmult"
declare cartprod_iff_sats [iff_sats]
synthesize "is_cmult" from_definition assuming "nonempty"
arity_theorem for "is_cmult_fm"
context M_Perm begin
rel_closed for "cmult"
using cardinal_rel_closed
unfolding cmult_rel_def
by simp
is_iff_rel for "cmult"
using is_cardinal_iff
unfolding is_cmult_def cmult_rel_def
by simp
end
endody>
Theory Univ_Relative
sectionâ¹Relativization of the cumulative hierarchyâº
theory Univ_Relative
imports
"ZF-Constructible.Rank"
"ZF.Univ"
Discipline_Cardinal
begin
declare arity_ordinal_fm[arity]
context M_trivial
begin
declare powerset_abs[simp]
lemma family_union_closed: "â¦strong_replacement(M, λx y. y = f(x)); M(A); âxâA. M(f(x))â§
â¹ M(âxâA. f(x))"
using RepFun_closed ..
lemma family_union_closed': "â¦strong_replacement(M, λx y. xâA ⧠y = f(x)); M(A); âxâA. M(f(x))â§
â¹ M(âxâA. f(x))"
using RepFun_closed2
by simp
end
definition
Powapply :: "[i,i] â i" where
"Powapply(f,y) â¡ Pow(f`y)"
reldb_add functional "Pow" "Pow_rel"
reldb_add relational "Pow" "is_Pow"
declare Replace_iff_sats[iff_sats]
synthesize "is_Pow" from_definition assuming "nonempty"
arity_theorem for "is_Pow_fm"
relativize functional "Powapply" "Powapply_rel"
relationalize "Powapply_rel" "is_Powapply"
synthesize "is_Powapply" from_definition assuming "nonempty"
arity_theorem for "is_Powapply_fm"
notation Powapply_rel (â¹Powapplyâ_â'(_,_')âº)
context M_basic
begin
rel_closed for "Powapply"
unfolding Powapply_rel_def
by simp
is_iff_rel for "Powapply"
using Pow_rel_iff
unfolding is_Powapply_def Powapply_rel_def
by simp
end
definition
HVfrom :: "[i,i,i] â i" where
"HVfrom(A,x,f) â¡ A ⪠(âyâx. Powapply(f,y))"
relativize functional "HVfrom" "HVfrom_rel"
relationalize "HVfrom_rel" "is_HVfrom"
synthesize "is_HVfrom" from_definition assuming "nonempty"
arity_theorem intermediate for "is_HVfrom_fm"
lemma arity_is_HVfrom_fm:
"A â nat â¹
x â nat â¹
f â nat â¹
d â nat â¹
arity(is_HVfrom_fm(A, x, f, d)) = succ(A) ⪠succ(d) ⪠(succ(x) ⪠succ(f))"
using arity_is_HVfrom_fm' arity_is_Powapply_fm
by(simp,subst arity_Replace_fm[of "is_Powapply_fm(succ(succ(succ(succ(f)))), 0, 1)" "succ(succ(x))" 1])
(simp_all, auto simp add:arity pred_Un_distrib)
notation HVfrom_rel (â¹HVfromâ_â'(_,_,_')âº)
locale M_HVfrom = M_eclose +
assumes
Powapply_replacement:
"M(f) â¹ strong_replacement(M,λy z. z = PowapplyâMâ(f,y))"
begin
is_iff_rel for "HVfrom"
proof -
assume assms:"M(A)" "M(x)" "M(f)" "M(res)"
then
have "is_Replace(M,x,λy z. z = PowapplyâMâ(f,y),r) â· r = {z . yâx, z = PowapplyâMâ(f,y)}"
if "M(r)" for r
using that Powapply_rel_closed
Replace_abs[of x r "λy z. z = PowapplyâMâ(f,y)"] transM[of _ x]
by simp
moreover
have "is_Replace(M,x,is_Powapply(M,f),r) â·
is_Replace(M,x,λy z. z = PowapplyâMâ(f,y),r)" if "M(r)" for r
using assms that is_Powapply_iff is_Replace_cong
by simp
ultimately
have "is_Replace(M,x,is_Powapply(M,f),r) â· r = {z . yâx, z = PowapplyâMâ(f,y)}"
if "M(r)" for r
using that assms
by simp
moreover
have "M({z . y â x, z = PowapplyâMâ(f,y)})"
using assms strong_replacement_closed[OF Powapply_replacement]
Powapply_rel_closed transM[of _ x]
by simp
moreover from assms
have "{z . y â x, z = PowapplyâMâ(f,y)} = {y . w â x, M(y) ⧠M(w) ⧠y = PowapplyâMâ(f,w)}"
by (auto dest:transM)
ultimately
show ?thesis
using assms
unfolding is_HVfrom_def HVfrom_rel_def
by (auto dest:transM)
qed
rel_closed for "HVfrom"
proof -
assume assms:"M(A)" "M(x)" "M(f)"
have "M({z . y â x, z = PowapplyâMâ(f,y)})"
using assms strong_replacement_closed[OF Powapply_replacement]
Powapply_rel_closed transM[of _ x]
by simp
then
have "M(A ⪠â({z . yâx, z = PowapplyâMâ(f,y)}))"
using assms
by simp
moreover from assms
have "{z . y â x, z = PowapplyâMâ(f,y)} = {y . w â x, M(y) ⧠M(w) ⧠y = PowapplyâMâ(f,w)}"
by (auto dest:transM)
ultimately
show ?thesis
using assms
unfolding HVfrom_rel_def
by simp
qed
end
definition
Vfrom_rel :: "[iâo,i,i] â i" (â¹Vfromâ_â'(_,_')âº) where
"VfromâMâ(A,i) = transrec(i, HVfrom_rel(M,A))"
definition
is_Vfrom :: "[iâo,i,i,i] â o" where
"is_Vfrom(M,A,i,z) â¡ is_transrec(M,is_HVfrom(M,A),i,z)"
definition
Hrank :: "[i,i] â i" where
"Hrank(x,f) â¡ (âyâx. succ(f`y))"
definition
rrank :: "i â i" where
"rrank(a) â¡ Memrel(eclose({a}))^+"
relativize functional "Hrank" "Hrank_rel"
relationalize "Hrank_rel" "is_Hrank"
synthesize "is_Hrank" from_definition assuming "nonempty"
lemma arity_is_Hrank_fm : "x â nat â¹
f â nat â¹
d â nat â¹
arity(is_Hrank_fm(x, f, d)) =
succ(d) ⪠succ(x) ⪠succ(f)"
unfolding is_Hrank_fm_def
using arity_fun_apply_fm arity_big_union_fm
arity_fun_apply_fm arity_succ_fm arity_And arity_Exists
arity_Replace_fm[of
"(â
ââ
â
succ(0) is 2â
⧠â
succ(succ(succ(succ(f))))`1 is 0â
â
â
)"
"succ(x)" 0 "4+â©Ïf"]
by(simp_all add:Un_assoc pred_Un,simp add:ord_simp_union)
locale M_Vfrom = M_HVfrom +
assumes
trepl_HVfrom : "⦠M(A);M(i) ⧠⹠transrec_replacement(M,is_HVfrom(M,A),i)"
and
Hrank_replacement : "M(f) ⹠strong_replacement(M,λx y . y = succ(f`x))"
and
is_Hrank_replacement : "M(x) â¹ wfrec_replacement(M,is_Hrank(M),rrank(x))"
and
HVfrom_replacement : "⦠M(i) ; M(A) ⧠â¹
transrec_replacement(M,is_HVfrom(M,A),i)"
begin
lemma Vfrom_rel_iff :
assumes "M(A)" "M(i)" "M(z)" "Ord(i)"
shows "is_Vfrom(M,A,i,z) â· z = VfromâMâ(A,i)"
proof -
have "relation2(M, is_HVfrom(M, A), HVfrom_rel(M, A))"
using assms is_HVfrom_iff
unfolding relation2_def
by simp
then
show ?thesis
using assms HVfrom_rel_closed trepl_HVfrom
transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)" z]
unfolding is_Vfrom_def Vfrom_rel_def
by simp
qed
lemma relation2_HVfrom: "M(A) â¹ relation2(M,is_HVfrom(M,A),HVfrom_rel(M,A))"
using is_HVfrom_iff
unfolding relation2_def
by auto
lemma HVfrom_closed :
"M(A) â¹ âx[M]. âg[M]. function(g) ⶠM(HVfrom_rel(M,A,x,g))"
using HVfrom_rel_closed by simp
lemma Vfrom_rel_closed:
assumes "M(A)" "M(i)" "Ord(i)"
shows "M(transrec(i, HVfrom_rel(M, A)))"
using is_HVfrom_iff HVfrom_closed HVfrom_replacement assms trepl_HVfrom relation2_HVfrom
transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"]
by simp
lemma transrec_HVfrom:
assumes "M(A)"
shows "Ord(i) â¹ M(i) â¹ {xâVfrom(A,i). M(x)} = transrec(i,HVfrom_rel(M,A))"
proof (induct rule:trans_induct)
have eq:"(âxâi. {x â Pow(transrec(x, HVfrom_rel(M, A))) . M(x)}) = â{y . x â i, y = PowâMâ(transrec(x, HVfrom_rel(M, A)))}"
if "Ord(i)" "M(i)" for i
using assms Pow_rel_char[OF Vfrom_rel_closed[OF â¹M(A)⺠transM[of _ i]]] Ord_in_Ord' that
by auto
case (step i)
then
have 0: "M(PowâMâ(transrec(x, HVfrom_rel(M, A))))" if "xâi" for x
using assms that transM[of _ i] Ord_in_Ord
transrec_closed[of "is_HVfrom(M,A)" _ "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
by auto
have "Vfrom(A,i) = A ⪠(âyâi. Pow((λxâi. Vfrom(A, x)) ` y))"
using def_transrec[OF Vfrom_def, of A i] by simp
then
have "Vfrom(A,i) = A ⪠(âyâi. Pow(Vfrom(A, y)))"
by simp
then
have "{xâVfrom(A,i). M(x)} = {xâA. M(x)} ⪠(âyâi. {xâPow(Vfrom(A, y)). M(x)})"
by auto
with â¹M(A)âº
have "{xâVfrom(A,i). M(x)} = A ⪠(âyâi. {xâPow(Vfrom(A, y)). M(x)})"
by (auto intro:transM)
also
have "... = A ⪠(âyâi. {xâPow({zâVfrom(A,y). M(z)}). M(x)})"
proof -
have "{xâPow(Vfrom(A, y)). M(x)} = {xâPow({zâVfrom(A,y). M(z)}). M(x)}"
if "yâi" for y by (auto intro:transM)
then
show ?thesis by simp
qed
also from step
have " ... = A ⪠(âyâi. {xâPow(transrec(y, HVfrom_rel(M, A))). M(x)})"
using transM[of _ i]
by auto
also
have " ... = transrec(i, HVfrom_rel(M, A))"
using 0 step assms transM[of _ i] eq
def_transrec[of "λy. transrec(y, HVfrom_rel(M, A))" "HVfrom_rel(M, A)" i]
unfolding Powapply_rel_def HVfrom_rel_def
by auto
finally
show ?case .
qed
lemma Vfrom_abs: "⦠M(A); M(i); M(V); Ord(i) ⧠⹠is_Vfrom(M,A,i,V) â· V = {xâVfrom(A,i). M(x)}"
unfolding is_Vfrom_def
using is_HVfrom_iff
transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
transrec_HVfrom
by simp
lemma Vfrom_closed: "⦠M(A); M(i); Ord(i) ⧠⹠M({xâVfrom(A,i). M(x)})"
unfolding is_Vfrom_def
using is_HVfrom_iff HVfrom_closed HVfrom_replacement
transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
transrec_HVfrom
by simp
end
subsectionâ¹Formula synthesisâº
context M_Vfrom
begin
rel_closed for "Hrank"
unfolding Hrank_rel_def
using Hrank_replacement
by simp
is_iff_rel for "Hrank"
proof -
assume "M(f)" "M(x)" "M(res)"
moreover from this
have "{a . y â x, M(a) ⧠M(y) ⧠a = succ(f ` y)} = {a . y â x, a = succ(f ` y)}"
using transM[of _ x]
by auto
ultimately
show ?thesis
unfolding is_Hrank_def Hrank_rel_def
using Replace_abs transM[of _ x] Hrank_replacement
by auto
qed
lemma relation2_Hrank :
"relation2(M,is_Hrank(M),Hrank)"
unfolding relation2_def
proof(clarify)
fix x f res
assume "M(x)" "M(f)" "M(res)"
moreover from this
have "{a . y â x, M(a) ⧠M(y) ⧠a = succ(f ` y)} = {a . y â x, a = succ(f ` y)}"
using transM[of _ x]
by auto
ultimately
show "is_Hrank(M, x, f, res) â· res = Hrank(x, f)"
unfolding Hrank_def relation2_def
using is_Hrank_iff[unfolded Hrank_rel_def]
by auto
qed
lemma Hrank_closed :
"âx[M]. âg[M]. function(g) ⶠM(Hrank(x,g))"
proof(clarify)
fix x g
assume "M(x)" "M(g)"
then
show "M(Hrank(x,g))"
using RepFun_closed[OF Hrank_replacement] transM[of _ x]
unfolding Hrank_def
by auto
qed
end
context M_eclose
begin
lemma wf_rrank : "M(x) â¹ wf(rrank(x))"
unfolding rrank_def using wf_trancl[OF wf_Memrel] .
lemma trans_rrank : "M(x) â¹ trans(rrank(x))"
unfolding rrank_def using trans_trancl .
lemma relation_rrank : "M(x) â¹ relation(rrank(x))"
unfolding rrank_def using relation_trancl .
lemma rrank_in_M : "M(x) â¹ M(rrank(x))"
unfolding rrank_def by simp
end
lemma Hrank_trancl:"Hrank(y, restrict(f,Memrel(eclose({x}))-``{y}))
= Hrank(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
unfolding Hrank_def
using restrict_trans_eq by simp
lemma rank_trancl: "rank(x) = wfrec(rrank(x), x, Hrank)"
proof -
have "rank(x) = wfrec(Memrel(eclose({x})), x, Hrank)"
(is "_ = wfrec(?r,_,_)")
unfolding rank_def transrec_def Hrank_def by simp
also
have " ... = wftrec(?r^+, x, λy f. Hrank(y, restrict(f,?r-``{y})))"
unfolding wfrec_def ..
also
have " ... = wftrec(?r^+, x, λy f. Hrank(y, restrict(f,(?r^+)-``{y})))"
using Hrank_trancl by simp
also
have " ... = wfrec(?r^+, x, Hrank)"
unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
finally
show ?thesis unfolding rrank_def .
qed
definition
Vset' :: "[i] â i" where
"Vset'(A) â¡ Vfrom(0,A)"
reldb_add relational "Vfrom" "is_Vfrom"
reldb_add functional "Vfrom" "Vfrom_rel"
relativize functional "Vset'" "Vset_rel"
relationalize "Vset_rel" "is_Vset"
reldb_rem relational "Vset"
reldb_rem functional "Vset_rel"
reldb_add relational "Vset" "is_Vset"
reldb_add functional "Vset" "Vset_rel"
schematic_goal sats_is_Vset_fm_auto:
assumes
"iânat" "vânat" "envâlist(A)" "0âA"
"i < length(env)" "v < length(env)"
shows
"is_Vset(##A,nth(i, env),nth(v, env)) â· sats(A,?ivs_fm(i,v),env)"
unfolding is_Vset_def is_Vfrom_def
by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
arity_theorem for "is_Vset_fm"
context M_Vfrom
begin
lemma Vset_abs: "⦠M(i); M(V); Ord(i) ⧠⹠is_Vset(M,i,V) â· V = {xâVset(i). M(x)}"
using Vfrom_abs unfolding is_Vset_def by simp
lemma Vset_closed: "⦠M(i); Ord(i) ⧠⹠M({xâVset(i). M(x)})"
using Vfrom_closed unfolding is_Vset_def by simp
lemma rank_closed: "M(a) â¹ M(rank(a))"
unfolding rank_trancl
using Hrank_closed is_Hrank_replacement relation2_Hrank
wf_rrank relation_rrank trans_rrank rrank_in_M
trans_wfrec_closed[of "rrank(a)" a "is_Hrank(M)"]
transM[of _ a]
by auto
lemma M_into_Vset:
assumes "M(a)"
shows "âi[M]. âV[M]. ordinal(M,i) ⧠is_Vset(M,i,V) ⧠aâV"
proof -
let ?i="succ(rank(a))"
from assms
have "aâ{xâVfrom(0,?i). M(x)}" (is "aâ?V")
using Vset_Ord_rank_iff by simp
moreover from assms
have "M(?i)"
using rank_closed by simp
moreover
note â¹M(a)âº
moreover from calculation
have "M(?V)"
using Vfrom_closed by simp
moreover from calculation
have "ordinal(M,?i) ⧠is_Vfrom(M, 0, ?i, ?V) ⧠a â ?V"
using Ord_rank Vfrom_abs by simp
ultimately
show ?thesis
using nonempty empty_abs
unfolding is_Vset_def
by blast
qed
end
end
Theory Cardinal_Relative
sectionâ¹Relative, Choice-less Cardinal Numbersâº
theory Cardinal_Relative
imports
Lambda_Replacement
Univ_Relative
begin
txtâ¹The following command avoids that a commonly used one-letter variable be
captured by the definition of the constructible universe \<^term>â¹Lâº.âº
hide_const (open) L
txtâ¹We also return to the old notation for \<^term>â¹sum⺠to preserve the old
Constructibility code.âº
no_notation oadd (infixl â¹+⺠65)
notation sum (infixr â¹+⺠65)
definition
Finite_rel :: "[iâo,i]=>o" where
"Finite_rel(M,A) â¡ âom[M]. ân[M]. omega(M,om) ⧠nâom ⧠eqpoll_rel(M,A,n)"
definition
banach_functor :: "[i,i,i,i,i] â i" where
"banach_functor(X,Y,f,g,W) â¡ X - g``(Y - f``W)"
definition
is_banach_functor :: "[iâo,i,i,i,i,i,i]âo" where
"is_banach_functor(M,X,Y,f,g,W,b) â¡
âfW[M]. âYfW[M]. âgYfW[M]. image(M,f,W,fW) ⧠setdiff(M,Y,fW,YfW) â§
image(M,g,YfW,gYfW) ⧠setdiff(M,X,gYfW,b)"
lemma (in M_basic) banach_functor_abs :
assumes "M(X)" "M(Y)" "M(f)" "M(g)"
shows "relation1(M,is_banach_functor(M,X,Y,f,g),banach_functor(X,Y,f,g))"
unfolding relation1_def is_banach_functor_def banach_functor_def
using assms
by simp
lemma (in M_basic) banach_functor_closed:
assumes "M(X)" "M(Y)" "M(f)" "M(g)"
shows "âW[M]. M(banach_functor(X,Y,f,g,W))"
unfolding banach_functor_def using assms image_closed
by simp
locale M_cardinals = M_ordertype + M_trancl + M_Perm + M_replacement_extra +
assumes
radd_separation: "M(R) â¹ M(S) â¹
separation(M, λz.
(âx y. z = â¨Inl(x), Inr(y)â©) â¨
(âx' x. z = â¨Inl(x'), Inl(x)⩠⧠â¨x', xâ© â R) â¨
(ây' y. z = â¨Inr(y'), Inr(y)⩠⧠â¨y', yâ© â S))"
and
rmult_separation: "M(b) â¹ M(d) â¹ separation(M,
λz. âx' y' x y. z = â¨â¨x', y'â©, x, y⩠⧠(â¨x', xâ© â b ⨠x' = x ⧠â¨y', yâ© â d))"
and
banach_repl_iter: "M(X) â¹ M(Y) â¹ M(f) â¹ M(g) â¹
strong_replacement(M, λx y. xânat ⧠y = banach_functor(X, Y, f, g)^x (0))"
begin
lemma rvimage_separation: "M(f) â¹ M(r) â¹
separation(M, λz. âx y. z = â¨x, y⩠⧠â¨f ` x, f ` yâ© â r)"
using separation_pair separation_in
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
lam_replacement_constant lam_replacement_apply2[THEN[5] lam_replacement_hcomp2,OF lam_replacement_constant[of f]]
lam_replacement_fst lam_replacement_snd
lam_replacement_identity lam_replacement_hcomp
by(simp_all)
lemma radd_closed[intro,simp]: "M(a) â¹ M(b) â¹ M(c) â¹ M(d) â¹ M(radd(a,b,c,d))"
using radd_separation by (auto simp add: radd_def)
lemma rmult_closed[intro,simp]: "M(a) â¹ M(b) â¹ M(c) â¹ M(d) â¹ M(rmult(a,b,c,d))"
using rmult_separation by (auto simp add: rmult_def)
end
lemma (in M_cardinals) is_cardinal_iff_Least:
assumes "M(A)" "M(κ)"
shows "is_cardinal(M,A,κ) ⷠκ = (μ i. M(i) ⧠i ââMâ A)"
using is_cardinal_iff assms
unfolding cardinal_rel_def by simp
subsectionâ¹The Schroeder-Bernstein Theoremâº
textâ¹See Davey and Priestly, page 106âº
context M_cardinals
begin
lemma bnd_mono_banach_functor: "bnd_mono(X, banach_functor(X,Y,f,g))"
unfolding bnd_mono_def banach_functor_def
by blast
lemma inj_Inter:
assumes "g â inj(Y,X)" "Aâ 0" "âaâA. a â Y"
shows "g``(âA) = (âaâA. g``a)"
proof (intro equalityI subsetI)
fix x
from assms
obtain a where "aâA" by blast
moreover
assume "x â (âaâA. g `` a)"
ultimately
have x_in_im: "x â g``y" if "yâA" for y
using that by auto
have exists: "âz â y. x = g`z" if "yâA" for y
proof -
note that
moreover from this and x_in_im
have "x â g``y" by simp
moreover from calculation
have "x â g``y" by simp
moreover
note assms
ultimately
show ?thesis
using image_fun[OF inj_is_fun] by auto
qed
with â¹aâAâº
obtain z where "z â a" "x = g`z" by auto
moreover
have "z â y" if "yâA" for y
proof -
from that and exists
obtain w where "w â y" "x = g`w" by auto
moreover from this â¹x = g`z⺠assms that â¹aâA⺠â¹zâaâº
have "z = w" unfolding inj_def by blast
ultimately
show ?thesis by simp
qed
moreover
note assms
moreover from calculation
have "z â âA" by auto
moreover from calculation
have "z â Y" by blast
ultimately
show "x â g `` (âA)"
using inj_is_fun[THEN funcI, of g] by fast
qed auto
lemma contin_banach_functor:
assumes "g â inj(Y,X)"
shows "contin(banach_functor(X,Y,f,g))"
unfolding contin_def
proof (intro allI impI)
fix A
assume "directed(A)"
then
have "A â 0"
unfolding directed_def ..
have "banach_functor(X, Y, f, g, âA) = X - g``(Y - f``(âA))"
unfolding banach_functor_def ..
also
have " ⦠= X - g``(Y - (âaâA. f``a))"
by auto
also from â¹Aâ 0âº
have " ⦠= X - g``(âaâA. Y-f``a)"
by auto
also from â¹Aâ 0⺠and assms
have " ⦠= X - (âaâA. g``(Y-f``a))"
using inj_Inter[of g Y X "{Y-f``a. aâA}" ] by fastforce
also from â¹Aâ 0âº
have " ⦠= (âaâA. X - g``(Y-f``a))" by simp
also
have " ⦠= (âaâA. banach_functor(X, Y, f, g, a))"
unfolding banach_functor_def ..
finally
show "banach_functor(X,Y,f,g,âA) = (âaâA. banach_functor(X,Y,f,g,a))" .
qed
lemma lfp_banach_functor:
assumes "gâinj(Y,X)"
shows "lfp(X, banach_functor(X,Y,f,g)) =
(ânânat. banach_functor(X,Y,f,g)^n (0))"
using assms lfp_eq_Union bnd_mono_banach_functor contin_banach_functor
by simp
lemma lfp_banach_functor_closed:
assumes "M(g)" "M(X)" "M(Y)" "M(f)" "gâinj(Y,X)"
shows "M(lfp(X, banach_functor(X,Y,f,g)))"
proof -
from assms
have "M(banach_functor(X,Y,f,g)^n (0))" if "nânat" for n
by(rule_tac nat_induct[OF that],simp_all add:banach_functor_closed)
with assms
show ?thesis
using family_union_closed'[OF banach_repl_iter M_nat] lfp_banach_functor
by simp
qed
lemma banach_decomposition_rel:
"[| M(f); M(g); M(X); M(Y); f â X->Y; g â inj(Y,X) |] ==>
âXA[M]. âXB[M]. âYA[M]. âYB[M].
(XA ⩠XB = 0) & (XA ⪠XB = X) &
(YA ⩠YB = 0) & (YA ⪠YB = Y) &
f``XA=YA & g``YB=XB"
apply (intro rexI conjI)
apply (rule_tac [6] Banach_last_equation)
apply (rule_tac [5] refl)
apply (assumption |
rule inj_is_fun Diff_disjoint Diff_partition fun_is_rel
image_subset lfp_subset)+
using lfp_banach_functor_closed[of g X Y f]
unfolding banach_functor_def by simp_all
lemma schroeder_bernstein_closed:
"[| M(f); M(g); M(X); M(Y); f â inj(X,Y); g â inj(Y,X) |] ==> âh[M]. h â bij(X,Y)"
apply (insert banach_decomposition_rel [of f g X Y])
apply (simp add: inj_is_fun)
apply (auto)
apply (rule_tac x="restrict(f,XA) ⪠converse(restrict(g,YB))" in rexI)
apply (auto intro!: restrict_bij bij_disjoint_Un intro: bij_converse_bij)
done
lemma mem_Pow_rel: "M(r) â¹ a â Pow_rel(M,r) â¹ a â Pow(r) ⧠M(a)"
using Pow_rel_char by simp
lemma mem_bij_abs[simp]: "â¦M(f);M(A);M(B)⧠⹠f â bijâMâ(A,B) â· fâbij(A,B)"
using bij_rel_char by simp
lemma mem_inj_abs[simp]: "â¦M(f);M(A);M(B)⧠⹠f â injâMâ(A,B) â· fâinj(A,B)"
using inj_rel_char by simp
lemma mem_surj_abs: "â¦M(f);M(A);M(B)⧠⹠f â surjâMâ(A,B) â· fâsurj(A,B)"
using surj_rel_char by simp
lemma bij_imp_eqpoll_rel:
assumes "f â bij(A,B)" "M(f)" "M(A)" "M(B)"
shows "A ââMâ B"
using assms by (auto simp add:def_eqpoll_rel)
lemma eqpoll_rel_refl: "M(A) â¹ A ââMâ A"
using bij_imp_eqpoll_rel[OF id_bij, OF id_closed] .
lemma eqpoll_rel_sym: "X ââMâ Y â¹ M(X) â¹ M(Y) â¹ Y ââMâ X"
unfolding def_eqpoll_rel using converse_closed
by (auto intro: bij_converse_bij)
lemma eqpoll_rel_trans [trans]:
"[|X ââMâ Y; Y ââMâ Z; M(X); M(Y) ; M(Z) |] ==> X ââMâ Z"
unfolding def_eqpoll_rel by (auto intro: comp_bij)
lemma subset_imp_lepoll_rel: "X â Y â¹ M(X) â¹ M(Y) â¹ X â²âMâ Y"
unfolding def_lepoll_rel using id_subset_inj id_closed
by simp blast
lemmas lepoll_rel_refl = subset_refl [THEN subset_imp_lepoll_rel, simp]
lemmas le_imp_lepoll_rel = le_imp_subset [THEN subset_imp_lepoll_rel]
lemma eqpoll_rel_imp_lepoll_rel: "X ââMâ Y ==> M(X) â¹ M(Y) â¹ X â²âMâ Y"
unfolding def_eqpoll_rel bij_def def_lepoll_rel using bij_is_inj
by (auto)
lemma lepoll_rel_trans [trans]:
assumes
"X â²âMâ Y" "Y â²âMâ Z" "M(X)" "M(Y)" "M(Z)"
shows
"X â²âMâ Z"
using assms def_lepoll_rel
by (auto intro: comp_inj)
lemma eq_lepoll_rel_trans [trans]:
assumes
"X ââMâ Y" "Y â²âMâ Z" "M(X)" "M(Y)" "M(Z)"
shows
"X â²âMâ Z"
using assms
by (blast intro: eqpoll_rel_imp_lepoll_rel lepoll_rel_trans)
lemma lepoll_rel_eq_trans [trans]:
assumes "X â²âMâ Y" "Y ââMâ Z" "M(X)" "M(Y)" "M(Z)"
shows "X â²âMâ Z"
using assms
eqpoll_rel_imp_lepoll_rel[of Y Z] lepoll_rel_trans[of X Y Z]
by simp
lemma eqpoll_relI: "⦠X â²âMâ Y; Y â²âMâ X; M(X) ; M(Y) ⧠⹠X ââMâ Y"
unfolding def_lepoll_rel def_eqpoll_rel using schroeder_bernstein_closed
by auto
lemma eqpoll_relE:
"[| X ââMâ Y; [| X â²âMâ Y; Y â²âMâ X |] ==> P ; M(X) ; M(Y) |] ==> P"
by (blast intro: eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym)
lemma eqpoll_rel_iff: "M(X) â¹ M(Y) â¹ X ââMâ Y â· X â²âMâ Y & Y â²âMâ X"
by (blast intro: eqpoll_relI elim: eqpoll_relE)
lemma lepoll_rel_0_is_0: "A â²âMâ 0 â¹ M(A) â¹ A = 0"
using def_lepoll_rel
by (cases "A=0") (auto simp add: inj_def)
lemmas empty_lepoll_relI = empty_subsetI [THEN subset_imp_lepoll_rel, OF nonempty]
lemma lepoll_rel_0_iff: "M(A) â¹ A â²âMâ 0 â· A=0"
by (blast intro: lepoll_rel_0_is_0 lepoll_rel_refl)
lemma Un_lepoll_rel_Un:
"[| A â²âMâ B; C â²âMâ D; B â© D = 0; M(A); M(B); M(C); M(D) |] ==> A ⪠C â²âMâ B ⪠D"
using def_lepoll_rel using inj_disjoint_Un[of _ A B _ C D] if_then_replacement
apply (auto)
apply (rule, assumption)
apply (auto intro!:lam_closed elim:transM)+
done
lemma eqpoll_rel_0_is_0: "A ââMâ 0 â¹ M(A) â¹ A = 0"
using eqpoll_rel_imp_lepoll_rel lepoll_rel_0_is_0 nonempty
by blast
lemma eqpoll_rel_0_iff: "M(A) â¹ A ââMâ 0 â· A=0"
by (blast intro: eqpoll_rel_0_is_0 eqpoll_rel_refl)
lemma eqpoll_rel_disjoint_Un:
"[| A ââMâ B; C ââMâ D; A â© C = 0; B â© D = 0; M(A); M(B); M(C) ; M(D) |]
==> A ⪠C ââMâ B ⪠D"
by (auto intro: bij_disjoint_Un simp add:def_eqpoll_rel)
subsectionâ¹lesspoll\_rel: contributions by Krzysztof Grabczewskiâº
lemma lesspoll_rel_not_refl: "M(i) â¹ ~ (i âºâMâ i)"
by (simp add: lesspoll_rel_def eqpoll_rel_refl)
lemma lesspoll_rel_irrefl: "i âºâMâ i ==> M(i) â¹ P"
by (simp add: lesspoll_rel_def eqpoll_rel_refl)
lemma lesspoll_rel_imp_lepoll_rel: "â¦A âºâMâ B; M(A); M(B)â§â¹ A â²âMâ B"
by (unfold lesspoll_rel_def, blast)
lemma rvimage_closed [intro,simp]:
assumes
"M(A)" "M(f)" "M(r)"
shows
"M(rvimage(A,f,r))"
unfolding rvimage_def using assms rvimage_separation by auto
lemma lepoll_rel_well_ord: "[| A â²âMâ B; well_ord(B,r); M(A); M(B); M(r) |] ==> âs[M]. well_ord(A,s)"
unfolding def_lepoll_rel by (auto intro:well_ord_rvimage)
lemma lepoll_rel_iff_leqpoll_rel: "â¦M(A); M(B)⧠⹠A â²âMâ B â· A âºâMâ B | A ââMâ B"
apply (unfold lesspoll_rel_def)
apply (blast intro: eqpoll_relI elim: eqpoll_relE)
done
end
context M_cardinals
begin
lemma inj_rel_is_fun_M: "f â injâMâ(A,B) â¹ M(f) â¹ M(A) â¹ M(B) â¹ f â A ââMâ B"
using inj_is_fun function_space_rel_char by simp
lemma inj_rel_not_surj_rel_succ:
notes mem_inj_abs[simp del]
assumes fi: "f â injâMâ(A, succ(m))" and fns: "f â surjâMâ(A, succ(m))"
and types: "M(f)" "M(A)" "M(m)"
shows "âf[M]. f â injâMâ(A,m)"
proof -
from fi [THEN inj_rel_is_fun_M] fns types
obtain y where y: "y â succ(m)" "âx. xâA â¹ f ` x â y" "M(y)"
by (auto simp add: def_surj_rel)
show ?thesis
proof
from types and â¹M(y)âº
show "M(λzâA. if f ` z = m then y else f ` z)"
using transM[OF _ â¹M(A)âº] lam_if_then_apply_replacement2 lam_replacement_iff_lam_closed
by (auto)
with types y fi
have "(λzâA. if f`z = m then y else f`z) â AââMâ m"
using function_space_rel_char inj_rel_char inj_is_fun[of f A "succ(m)"]
by (auto intro!: if_type [THEN lam_type] dest: apply_funtype)
with types y fi
show "(λzâA. if f`z = m then y else f`z) â injâMâ(A, m)"
by (simp add: def_inj_rel) blast
qed
qed
lemma lesspoll_rel_trans [trans]:
"[| X âºâMâ Y; Y âºâMâ Z; M(X); M(Y) ; M(Z) |] ==> X âºâMâ Z"
apply (unfold lesspoll_rel_def)
apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
done
lemma lesspoll_rel_trans1 [trans]:
"[| X â²âMâ Y; Y âºâMâ Z; M(X); M(Y) ; M(Z) |] ==> X âºâMâ Z"
apply (unfold lesspoll_rel_def)
apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
done
lemma lesspoll_rel_trans2 [trans]:
"[| X âºâMâ Y; Y â²âMâ Z; M(X); M(Y) ; M(Z)|] ==> X âºâMâ Z"
apply (unfold lesspoll_rel_def)
apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
done
lemma eq_lesspoll_rel_trans [trans]:
"[| X ââMâ Y; Y âºâMâ Z; M(X); M(Y) ; M(Z) |] ==> X âºâMâ Z"
by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans1)
lemma lesspoll_rel_eq_trans [trans]:
"[| X âºâMâ Y; Y ââMâ Z; M(X); M(Y) ; M(Z) |] ==> X âºâMâ Z"
by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans2)
lemma is_cardinal_cong:
assumes "X ââMâ Y" "M(X)" "M(Y)"
shows "âκ[M]. is_cardinal(M,X,κ) ⧠is_cardinal(M,Y,κ)"
proof -
from assms
have "(μ i. M(i) ⧠i ââMâ X) = (μ i. M(i) ⧠i ââMâ Y)"
by (intro Least_cong) (auto intro: comp_bij bij_converse_bij simp add:def_eqpoll_rel)
moreover from assms
have "M(μ i. M(i) ⧠i ââMâ X)"
using Least_closed' by fastforce
moreover
note assms
ultimately
show ?thesis
using is_cardinal_iff_Least
by auto
qed
lemma cardinal_rel_cong: "X ââMâ Y â¹ M(X) â¹ M(Y) â¹ |X|âMâ = |Y|âMâ"
apply (simp add: def_eqpoll_rel cardinal_rel_def)
apply (rule Least_cong)
apply (auto intro: comp_bij bij_converse_bij)
done
lemma well_ord_is_cardinal_eqpoll_rel:
assumes "well_ord(A,r)" shows "is_cardinal(M,A,κ) â¹ M(A) â¹ M(κ) â¹ M(r) ⹠κ ââMâ A"
proof (subst is_cardinal_iff_Least[THEN iffD1, of A κ])
assume "M(A)" "M(κ)" "M(r)" "is_cardinal(M,A,κ)"
moreover from assms and calculation
obtain f i where "M(f)" "Ord(i)" "M(i)" "f â bij(A,i)"
using ordertype_exists[of A r] ord_iso_is_bij by auto
moreover
have "M(μ i. M(i) ⧠i ââMâ A)"
using Least_closed' by fastforce
ultimately
show "(μ i. M(i) ⧠i ââMâ A) ââMâ A"
using assms[THEN well_ord_imp_relativized]
LeastI[of "λi. M(i) ⧠i ââMâ A" i] Ord_ordertype[OF assms]
bij_converse_bij[THEN bij_imp_eqpoll_rel, of f] by simp
qed
lemmas Ord_is_cardinal_eqpoll_rel = well_ord_Memrel[THEN well_ord_is_cardinal_eqpoll_rel]
sectionâ¹Porting from \<^theory>â¹ZF.Cardinalâºâº
txtâ¹The following results were ported more or less directly from \<^theory>â¹ZF.Cardinalâºâº
lemma well_ord_cardinal_rel_eqpoll_rel:
assumes r: "well_ord(A,r)" and "M(A)" "M(r)" shows "|A|âMâ ââMâ A"
using assms well_ord_is_cardinal_eqpoll_rel is_cardinal_iff
by blast
lemmas Ord_cardinal_rel_eqpoll_rel = well_ord_Memrel[THEN well_ord_cardinal_rel_eqpoll_rel]
lemma Ord_cardinal_rel_idem: "Ord(A) â¹ M(A) â¹ ||A|âMâ|âMâ = |A|âMâ"
by (rule_tac Ord_cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong]) auto
lemma well_ord_cardinal_rel_eqE:
assumes woX: "well_ord(X,r)" and woY: "well_ord(Y,s)" and eq: "|X|âMâ = |Y|âMâ"
and types: "M(X)" "M(r)" "M(Y)" "M(s)"
shows "X ââMâ Y"
proof -
from types
have "X ââMâ |X|âMâ" by (blast intro: well_ord_cardinal_rel_eqpoll_rel [OF woX] eqpoll_rel_sym)
also
have "... = |Y|âMâ" by (rule eq)
also from types
have "... ââMâ Y" by (rule_tac well_ord_cardinal_rel_eqpoll_rel [OF woY])
finally show ?thesis by (simp add:types)
qed
lemma well_ord_cardinal_rel_eqpoll_rel_iff:
"[| well_ord(X,r); well_ord(Y,s); M(X); M(r); M(Y); M(s) |] ==> |X|âMâ = |Y|âMâ â· X ââMâ Y"
by (blast intro: cardinal_rel_cong well_ord_cardinal_rel_eqE)
lemma Ord_cardinal_rel_le: "Ord(i) â¹ M(i) ==> |i|âMâ ⤠i"
unfolding cardinal_rel_def
using eqpoll_rel_refl Least_le by simp
lemma Card_rel_cardinal_rel_eq: "CardâMâ(K) ==> M(K) â¹ |K|âMâ = K"
apply (unfold Card_rel_def)
apply (erule sym)
done
lemma Card_relI: "[| Ord(i); !!j. j<i â¹ M(j) ==> ~(j ââMâ i); M(i) |] ==> CardâMâ(i)"
apply (unfold Card_rel_def cardinal_rel_def)
apply (subst Least_equality)
apply (blast intro: eqpoll_rel_refl)+
done
lemma Card_rel_is_Ord: "CardâMâ(i) ==> M(i) â¹ Ord(i)"
apply (unfold Card_rel_def cardinal_rel_def)
apply (erule ssubst)
apply (rule Ord_Least)
done
lemma Card_rel_cardinal_rel_le: "CardâMâ(K) ==> M(K) â¹ K ⤠|K|âMâ"
apply (simp (no_asm_simp) add: Card_rel_is_Ord Card_rel_cardinal_rel_eq)
done
lemma Ord_cardinal_rel [simp,intro!]: "M(A) â¹ Ord(|A|âMâ)"
apply (unfold cardinal_rel_def)
apply (rule Ord_Least)
done
lemma Card_rel_iff_initial: assumes types:"M(K)"
shows "CardâMâ(K) â· Ord(K) & (âj[M]. j<K ⶠ~ (j ââMâ K))"
proof -
{ fix j
assume K: "CardâMâ(K)" "M(j) ⧠j ââMâ K"
assume "j < K"
also have "... = (μ i. M(i) ⧠i ââMâ K)" using K
by (simp add: Card_rel_def cardinal_rel_def types)
finally have "j < (μ i. M(i) ⧠i ââMâ K)" .
then have "False" using K
by (best intro: less_LeastE[of "λj. M(j) ⧠j ââMâ K"])
}
with types
show ?thesis
by (blast intro: Card_relI Card_rel_is_Ord)
qed
lemma lt_Card_rel_imp_lesspoll_rel: "[| CardâMâ(a); i<a; M(a); M(i) |] ==> i âºâMâ a"
apply (unfold lesspoll_rel_def)
apply (frule Card_rel_iff_initial [THEN iffD1], assumption)
apply (blast intro!: leI [THEN le_imp_lepoll_rel])
done
lemma Card_rel_0: "CardâMâ(0)"
apply (rule Ord_0 [THEN Card_relI])
apply (auto elim!: ltE)
done
lemma Card_rel_Un: "[| CardâMâ(K); CardâMâ(L); M(K); M(L) |] ==> CardâMâ(K ⪠L)"
apply (rule Ord_linear_le [of K L])
apply (simp_all add: subset_Un_iff [THEN iffD1] Card_rel_is_Ord le_imp_subset
subset_Un_iff2 [THEN iffD1])
done
lemma Card_rel_cardinal_rel [iff]: assumes types:"M(A)" shows "CardâMâ(|A|âMâ)"
using assms
proof (unfold cardinal_rel_def)
show "CardâMâ(μ i. M(i) ⧠i ââMâ A)"
proof (cases "âi[M]. Ord (i) ⧠i ââMâ A")
case False thus ?thesis
using Least_0[of "λi. M(i) ⧠i ââMâ A"] Card_rel_0
by fastforce
next
case True
then obtain i where i: "Ord(i)" "i ââMâ A" "M(i)" by blast
show ?thesis
proof (rule Card_relI [OF Ord_Least], rule notI)
fix j
assume j: "j < (μ i. M(i) ⧠i ââMâ A)" and "M(j)"
assume "j ââMâ (μ i. M(i) ⧠i ââMâ A)"
also have "... ââMâ A" using i LeastI[of "λi. M(i) ⧠i ââMâ A"] by (auto)
finally have "j ââMâ A"
using Least_closed'[of "λi. M(i) ⧠i ââMâ A"] by (simp add: â¹M(j)⺠types)
thus False
using â¹M(j)⺠by (blast intro:less_LeastE [OF _ j])
qed (auto intro:Least_closed)
qed
qed
lemma cardinal_rel_eq_lemma:
assumes i:"|i|âMâ ⤠j" and j: "j ⤠i" and types: "M(i)" "M(j)"
shows "|j|âMâ = |i|âMâ"
proof (rule eqpoll_relI [THEN cardinal_rel_cong])
show "j â²âMâ i" by (rule le_imp_lepoll_rel [OF j]) (simp_all add:types)
next
have Oi: "Ord(i)" using j by (rule le_Ord2)
with types
have "i ââMâ |i|âMâ"
by (blast intro: Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
also from types
have "... â²âMâ j"
by (blast intro: le_imp_lepoll_rel i)
finally show "i â²âMâ j" by (simp_all add:types)
qed (simp_all add:types)
lemma cardinal_rel_mono:
assumes ij: "i ⤠j" and types:"M(i)" "M(j)" shows "|i|âMâ ⤠|j|âMâ"
using Ord_cardinal_rel [OF â¹M(i)âº] Ord_cardinal_rel [OF â¹M(j)âº]
proof (cases rule: Ord_linear_le)
case le then show ?thesis .
next
case ge
have i: "Ord(i)" using ij
by (simp add: lt_Ord)
have ci: "|i|âMâ ⤠j"
by (blast intro: Ord_cardinal_rel_le ij le_trans i types)
have "|i|âMâ = ||i|âMâ|âMâ"
by (auto simp add: Ord_cardinal_rel_idem i types)
also have "... = |j|âMâ"
by (rule cardinal_rel_eq_lemma [OF ge ci]) (simp_all add:types)
finally have "|i|âMâ = |j|âMâ" .
thus ?thesis by (simp add:types)
qed
lemma cardinal_rel_lt_imp_lt: "[| |i|âMâ < |j|âMâ; Ord(i); Ord(j); M(i); M(j) |] ==> i < j"
apply (rule Ord_linear2 [of i j], assumption+)
apply (erule lt_trans2 [THEN lt_irrefl])
apply (erule cardinal_rel_mono, assumption+)
done
lemma Card_rel_lt_imp_lt: "[| |i|âMâ < K; Ord(i); CardâMâ(K); M(i); M(K)|] ==> i < K"
by (simp (no_asm_simp) add: cardinal_rel_lt_imp_lt Card_rel_is_Ord Card_rel_cardinal_rel_eq)
lemma Card_rel_lt_iff: "[| Ord(i); CardâMâ(K); M(i); M(K) |] ==> (|i|âMâ < K) â· (i < K)"
by (blast intro: Card_rel_lt_imp_lt Ord_cardinal_rel_le [THEN lt_trans1])
lemma Card_rel_le_iff: "[| Ord(i); CardâMâ(K); M(i); M(K) |] ==> (K ⤠|i|âMâ) â· (K ⤠i)"
by (simp add: Card_rel_lt_iff Card_rel_is_Ord not_lt_iff_le [THEN iff_sym])
lemma well_ord_lepoll_rel_imp_cardinal_rel_le:
assumes wB: "well_ord(B,r)" and AB: "A â²âMâ B"
and
types: "M(B)" "M(r)" "M(A)"
shows "|A|âMâ ⤠|B|âMâ"
using Ord_cardinal_rel [OF â¹M(A)âº] Ord_cardinal_rel [OF â¹M(B)âº]
proof (cases rule: Ord_linear_le)
case le thus ?thesis .
next
case ge
from lepoll_rel_well_ord [OF AB wB]
obtain s where s: "well_ord(A, s)" "M(s)" by (blast intro:types)
have "B ââMâ |B|âMâ" by (blast intro: wB eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel types)
also have "... â²âMâ |A|âMâ" by (rule le_imp_lepoll_rel [OF ge]) (simp_all add:types)
also have "... ââMâ A" by (rule well_ord_cardinal_rel_eqpoll_rel [OF s(1) _ s(2)]) (simp_all add:types)
finally have "B â²âMâ A" by (simp_all add:types)
hence "A ââMâ B" by (blast intro: eqpoll_relI AB types)
hence "|A|âMâ = |B|âMâ" by (rule cardinal_rel_cong) (simp_all add:types)
thus ?thesis by (simp_all add:types)
qed
lemma lepoll_rel_cardinal_rel_le: "[| A â²âMâ i; Ord(i); M(A); M(i) |] ==> |A|âMâ ⤠i"
using Memrel_closed
apply (rule_tac le_trans)
apply (erule well_ord_Memrel [THEN well_ord_lepoll_rel_imp_cardinal_rel_le], assumption+)
apply (erule Ord_cardinal_rel_le, assumption)
done
lemma lepoll_rel_Ord_imp_eqpoll_rel: "[| A â²âMâ i; Ord(i); M(A); M(i) |] ==> |A|âMâ ââMâ A"
by (blast intro: lepoll_rel_cardinal_rel_le well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel dest!: lepoll_rel_well_ord)
lemma lesspoll_rel_imp_eqpoll_rel: "[| A âºâMâ i; Ord(i); M(A); M(i) |] ==> |A|âMâ ââMâ A"
using lepoll_rel_Ord_imp_eqpoll_rel[OF lesspoll_rel_imp_lepoll_rel] .
lemma lesspoll_cardinal_lt_rel:
shows "[| A âºâMâ i; Ord(i); M(i); M(A) |] ==> |A|âMâ < i"
proof -
assume assms:"A âºâMâ i" â¹Ord(i)⺠â¹M(i)⺠â¹M(A)âº
then
have A:"Ord(|A|âMâ)" "|A|âMâ ââMâ A" "M(|A|âMâ)"
using Ord_cardinal_rel lesspoll_rel_imp_eqpoll_rel
by simp_all
with assms
have "|A|âMâ âºâMâ i"
using eq_lesspoll_rel_trans by auto
consider "|A|âMââi" | "|A|âMâ=i" | "iâ|A|âMâ"
using Ord_linear[OF â¹Ord(i)⺠â¹Ord(|A|âMâ)âº] by auto
then
have "|A|âMâ < i"
proof(cases)
case 1
then show ?thesis using ltI â¹Ord(i)⺠by simp
next
case 2
with â¹|A|âMâ âºâMâ i⺠â¹M(i)âº
show ?thesis using lesspoll_rel_irrefl by simp
next
case 3
with â¹Ord(|A|âMâ)âº
have "i<|A|âMâ" using ltI by simp
with â¹M(A)⺠A â¹M(i)âº
have "i âºâMâ |A|âMâ"
using lt_Card_rel_imp_lesspoll_rel Card_rel_cardinal_rel by simp
with â¹M(|A|âMâ)⺠â¹M(i)âº
show ?thesis
using lesspoll_rel_irrefl lesspoll_rel_trans[OF â¹|A|âMâ âºâMâ i⺠â¹i âºâMâ _ âº]
by simp
qed
then show ?thesis by simp
qed
lemma cardinal_rel_subset_Ord: "[|A<=i; Ord(i); M(A); M(i)|] ==> |A|âMâ â i"
apply (drule subset_imp_lepoll_rel [THEN lepoll_rel_cardinal_rel_le])
apply (auto simp add: lt_def)
apply (blast intro: Ord_trans)
done
lemma cons_lepoll_rel_consD:
"[| cons(u,A) â²âMâ cons(v,B); uâA; vâB; M(u); M(A); M(v); M(B) |] ==> A â²âMâ B"
apply (simp add: def_lepoll_rel, unfold inj_def, safe)
apply (rule_tac x = "λxâA. if f`x=v then f`u else f`x" in rexI)
apply (rule CollectI)
apply (rule if_type [THEN lam_type])
apply (blast dest: apply_funtype)
apply (blast elim!: mem_irrefl dest: apply_funtype)
apply (auto simp add:transM[of _ A])
using lam_replacement_iff_lam_closed lam_if_then_apply_replacement
by simp
lemma cons_eqpoll_rel_consD: "[| cons(u,A) ââMâ cons(v,B); uâA; vâB; M(u); M(A); M(v); M(B) |] ==> A ââMâ B"
apply (simp add: eqpoll_rel_iff)
apply (blast intro: cons_lepoll_rel_consD)
done
lemma succ_lepoll_rel_succD: "succ(m) â²âMâ succ(n) â¹ M(m) â¹ M(n) ==> m â²âMâ n"
apply (unfold succ_def)
apply (erule cons_lepoll_rel_consD)
apply (rule mem_not_refl)+
apply assumption+
done
lemma nat_lepoll_rel_imp_le:
"m â nat ==> n â nat â¹ m â²âMâ n â¹ M(m) â¹ M(n) â¹ m ⤠n"
proof (induct m arbitrary: n rule: nat_induct)
case 0 thus ?case by (blast intro!: nat_0_le)
next
case (succ m)
show ?case using â¹n â natâº
proof (cases rule: natE)
case 0 thus ?thesis using succ
by (simp add: def_lepoll_rel inj_def)
next
case (succ n') thus ?thesis using succ.hyps â¹ succ(m) â²âMâ nâº
by (blast dest!: succ_lepoll_rel_succD)
qed
qed
lemma nat_eqpoll_rel_iff: "[| m â nat; n â nat; M(m); M(n) |] ==> m ââMâ n â· m = n"
apply (rule iffI)
apply (blast intro: nat_lepoll_rel_imp_le le_anti_sym elim!: eqpoll_relE)
apply (simp add: eqpoll_rel_refl)
done
lemma nat_into_Card_rel:
assumes n: "n â nat" and types: "M(n)" shows "CardâMâ(n)"
using types
apply (subst Card_rel_def)
proof (unfold cardinal_rel_def, rule sym)
have "Ord(n)" using n by auto
moreover
{ fix i
assume "i < n" "M(i)" "i ââMâ n"
hence False using n
by (auto simp add: lt_nat_in_nat [THEN nat_eqpoll_rel_iff] types)
}
ultimately show "(μ i. M(i) ⧠i ââMâ n) = n" by (auto intro!: Least_equality types eqpoll_rel_refl)
qed
lemmas cardinal_rel_0 = nat_0I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
lemmas cardinal_rel_1 = nat_1I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
lemma succ_lepoll_rel_natE: "[| succ(n) â²âMâ n; n â nat |] ==> P"
by (rule nat_lepoll_rel_imp_le [THEN lt_irrefl], auto)
lemma nat_lepoll_rel_imp_ex_eqpoll_rel_n:
"[| n â nat; nat â²âMâ X ; M(n); M(X)|] ==> âY[M]. Y â X & n ââMâ Y"
apply (simp add: def_lepoll_rel def_eqpoll_rel)
apply (fast del: subsetI subsetCE
intro!: subset_SIs
dest!: Ord_nat [THEN [2] OrdmemD, THEN [2] restrict_inj]
elim!: restrict_bij
inj_is_fun [THEN fun_is_rel, THEN image_subset])
done
lemma lepoll_rel_succ: "M(i) â¹ i â²âMâ succ(i)"
by (blast intro: subset_imp_lepoll_rel)
lemma lepoll_rel_imp_lesspoll_rel_succ:
assumes A: "A â²âMâ m" and m: "m â nat"
and types: "M(A)" "M(m)"
shows "A âºâMâ succ(m)"
proof -
{ assume "A ââMâ succ(m)"
hence "succ(m) ââMâ A" by (rule eqpoll_rel_sym) (auto simp add:types)
also have "... â²âMâ m" by (rule A)
finally have "succ(m) â²âMâ m" by (auto simp add:types)
hence False by (rule succ_lepoll_rel_natE) (rule m) }
moreover have "A â²âMâ succ(m)" by (blast intro: lepoll_rel_trans A lepoll_rel_succ types)
ultimately show ?thesis by (auto simp add: types lesspoll_rel_def)
qed
lemma lesspoll_rel_succ_imp_lepoll_rel:
"[| A âºâMâ succ(m); m â nat; M(A); M(m) |] ==> A â²âMâ m"
proof -
{
assume "m â nat" "M(A)" "M(m)" "A â²âMâ succ(m)"
"âfâinjâMâ(A, succ(m)). f â surjâMâ(A, succ(m))"
moreover from this
obtain f where "M(f)" "fâinjâMâ(A,succ(m))"
using def_lepoll_rel by auto
moreover from calculation
have "f â surjâMâ(A, succ(m))" by simp
ultimately
have "âf[M]. f â injâMâ(A, m)"
using inj_rel_not_surj_rel_succ by auto
}
from this
show "⦠A âºâMâ succ(m); m â nat; M(A); M(m) ⧠⹠A â²âMâ m"
unfolding lepoll_rel_def eqpoll_rel_def bij_rel_def lesspoll_rel_def
by (simp del:mem_inj_abs)
qed
lemma lesspoll_rel_succ_iff: "m â nat â¹ M(A) ==> A âºâMâ succ(m) â· A â²âMâ m"
by (blast intro!: lepoll_rel_imp_lesspoll_rel_succ lesspoll_rel_succ_imp_lepoll_rel)
lemma lepoll_rel_succ_disj: "[| A â²âMâ succ(m); m â nat; M(A) ; M(m)|] ==> A â²âMâ m | A ââMâ succ(m)"
apply (rule disjCI)
apply (rule lesspoll_rel_succ_imp_lepoll_rel)
prefer 2 apply assumption
apply (simp (no_asm_simp) add: lesspoll_rel_def, assumption+)
done
lemma lesspoll_rel_cardinal_rel_lt: "[| A âºâMâ i; Ord(i); M(A); M(i) |] ==> |A|âMâ < i"
apply (unfold lesspoll_rel_def, clarify)
apply (frule lepoll_rel_cardinal_rel_le, assumption+)
apply (blast intro: well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym]
dest: lepoll_rel_well_ord elim!: leE)
done
lemma lt_not_lepoll_rel:
assumes n: "n<i" "n â nat"
and types:"M(n)" "M(i)" shows "~ i â²âMâ n"
proof -
{ assume i: "i â²âMâ n"
have "succ(n) â²âMâ i" using n
by (elim ltE, blast intro: Ord_succ_subsetI [THEN subset_imp_lepoll_rel] types)
also have "... â²âMâ n" by (rule i)
finally have "succ(n) â²âMâ n" by (simp add:types)
hence False by (rule succ_lepoll_rel_natE) (rule n) }
thus ?thesis by auto
qed
textâ¹A slightly weaker version of â¹nat_eqpoll_rel_iffâºâº
lemma Ord_nat_eqpoll_rel_iff:
assumes i: "Ord(i)" and n: "n â nat"
and types: "M(i)" "M(n)"
shows "i ââMâ n â· i=n"
using i nat_into_Ord [OF n]
proof (cases rule: Ord_linear_lt)
case lt
hence "i â nat" by (rule lt_nat_in_nat) (rule n)
thus ?thesis by (simp add: nat_eqpoll_rel_iff n types)
next
case eq
thus ?thesis by (simp add: eqpoll_rel_refl types)
next
case gt
hence "~ i â²âMâ n" using n by (rule lt_not_lepoll_rel) (simp_all add: types)
hence "~ i ââMâ n" using n by (blast intro: eqpoll_rel_imp_lepoll_rel types)
moreover have "i â n" using â¹n<i⺠by auto
ultimately show ?thesis by blast
qed
lemma Card_rel_nat: "CardâMâ(nat)"
proof -
{ fix i
assume i: "i < nat" "i ââMâ nat" "M(i)"
hence "~ nat â²âMâ i"
by (simp add: lt_def lt_not_lepoll_rel)
hence False using i
by (simp add: eqpoll_rel_iff)
}
hence "(μ i. M(i) ⧠i ââMâ nat) = nat" by (blast intro: Least_equality eqpoll_rel_refl)
thus ?thesis
by (auto simp add: Card_rel_def cardinal_rel_def)
qed
lemma nat_le_cardinal_rel: "nat ⤠i â¹ M(i) ==> nat ⤠|i|âMâ"
apply (rule Card_rel_nat [THEN Card_rel_cardinal_rel_eq, THEN subst], simp_all)
apply (erule cardinal_rel_mono, simp_all)
done
lemma n_lesspoll_rel_nat: "n â nat ==> n âºâMâ nat"
by (blast intro: Card_rel_nat ltI lt_Card_rel_imp_lesspoll_rel)
lemma cons_lepoll_rel_cong:
"[| A â²âMâ B; b â B; M(A); M(B); M(b); M(a) |] ==> cons(a,A) â²âMâ cons(b,B)"
apply (subst (asm) def_lepoll_rel, simp_all, subst def_lepoll_rel, simp_all, safe)
apply (rule_tac x = "λyâcons (a,A) . if y=a then b else f`y" in rexI)
apply (rule_tac d = "%z. if z â B then converse (f) `z else a" in lam_injective)
apply (safe elim!: consE')
apply simp_all
apply (blast intro: inj_is_fun [THEN apply_type])+
apply (auto intro:lam_closed lam_if_then_replacement simp add:transM[of _ A])
done
lemma cons_eqpoll_rel_cong:
"[| A ââMâ B; a â A; b â B; M(A); M(B); M(a) ; M(b) |] ==> cons(a,A) ââMâ cons(b,B)"
by (simp add: eqpoll_rel_iff cons_lepoll_rel_cong)
lemma cons_lepoll_rel_cons_iff:
"[| a â A; b â B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) â²âMâ cons(b,B) â· A â²âMâ B"
by (blast intro: cons_lepoll_rel_cong cons_lepoll_rel_consD)
lemma cons_eqpoll_rel_cons_iff:
"[| a â A; b â B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) ââMâ cons(b,B) â· A ââMâ B"
by (blast intro: cons_eqpoll_rel_cong cons_eqpoll_rel_consD)
lemma singleton_eqpoll_rel_1: "M(a) â¹ {a} ââMâ 1"
apply (unfold succ_def)
apply (blast intro!: eqpoll_rel_refl [THEN cons_eqpoll_rel_cong])
done
lemma cardinal_rel_singleton: "M(a) â¹ |{a}|âMâ = 1"
apply (rule singleton_eqpoll_rel_1 [THEN cardinal_rel_cong, THEN trans])
apply (simp (no_asm) add: nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq])
apply auto
done
lemma not_0_is_lepoll_rel_1: "A â 0 ==> M(A) â¹ 1 â²âMâ A"
apply (erule not_emptyE)
apply (rule_tac a = "cons (x, A-{x}) " in subst)
apply (rule_tac [2] a = "cons(0,0)" and P= "%y. y â²âMâ cons (x, A-{x})" in subst)
apply auto
proof -
fix x
assume "M(A)"
then
show "x â A â¹ {0} â²âMâ cons(x, A - {x})"
by (auto intro: cons_lepoll_rel_cong transM[OF _ â¹M(A)âº] subset_imp_lepoll_rel)
qed
lemma succ_eqpoll_rel_cong: "A ââMâ B â¹ M(A) â¹ M(B) ==> succ(A) ââMâ succ(B)"
apply (unfold succ_def)
apply (simp add: cons_eqpoll_rel_cong mem_not_refl)
done
textâ¹The next result was not straightforward to port, and even a
different statement was needed.âº
lemma sum_bij_rel:
"[| f â bijâMâ(A,C); g â bijâMâ(B,D); M(f); M(A); M(C); M(g); M(B); M(D)|]
==> (λzâA+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) â bijâMâ(A+B, C+D)"
proof -
assume asm:"f â bijâMâ(A,C)" "g â bijâMâ(B,D)" "M(f)" "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
then
have "M(λzâA+B. case(%x. Inl(f`x), %y. Inr(g`y), z))"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº]
by (auto intro:case_replacement4[THEN lam_closed])
with asm
show ?thesis
apply simp
apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))"
in lam_bijective)
apply (typecheck add: bij_is_inj inj_is_fun)
apply (auto simp add: left_inverse_bij right_inverse_bij)
done
qed
lemma sum_bij_rel':
assumes "f â bijâMâ(A,C)" "g â bijâMâ(B,D)" "M(f)"
"M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
shows
"(λzâA+B. case(λx. Inl(f`x), λy. Inr(g`y), z)) â bij(A+B, C+D)"
"M(λzâA+B. case(λx. Inl(f`x), λy. Inr(g`y), z))"
proof -
from assms
show "M(λzâA+B. case(λx. Inl(f`x), λy. Inr(g`y), z))"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº]
by (auto intro:case_replacement4[THEN lam_closed])
with assms
show "(λzâA+B. case(λx. Inl(f`x), λy. Inr(g`y), z)) â bij(A+B, C+D)"
apply simp
apply (rule_tac d = "case (%x. Inl (converse(f)`x), %y. Inr(converse(g)`y))"
in lam_bijective)
apply (typecheck add: bij_is_inj inj_is_fun)
apply (auto simp add: left_inverse_bij right_inverse_bij)
done
qed
lemma sum_eqpoll_rel_cong:
assumes "A ââMâ C" "B ââMâ D" "M(A)" "M(C)" "M(B)" "M(D)"
shows "A+B ââMâ C+D"
using assms
proof (simp add: def_eqpoll_rel, safe, rename_tac g)
fix f g
assume "M(f)" "f â bij(A, C)" "M(g)" "g â bij(B, D)"
with assms
obtain h where "hâbij(A+B, C+D)" "M(h)"
using sum_bij_rel'[of f A C g B D] by simp
then
show "âf[M]. f â bij(A + B, C + D)"
by auto
qed
lemma prod_bij_rel':
assumes "f â bijâMâ(A,C)" "g â bijâMâ(B,D)" "M(f)"
"M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
shows
"(λ<x,y>âA*B. <f`x, g`y>) â bij(A*B, C*D)"
"M(λ<x,y>âA*B. <f`x, g`y>)"
proof -
from assms
show "M((λ<x,y>âA*B. <f`x, g`y>))"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº]
transM[OF _ cartprod_closed, of _ A B]
by (auto intro:prod_fun_replacement[THEN lam_closed, of f g "AÃB"])
with assms
show "(λ<x,y>âA*B. <f`x, g`y>) â bij(A*B, C*D)"
apply simp
apply (rule_tac d = "%<x,y>. <converse (f) `x, converse (g) `y>"
in lam_bijective)
apply (typecheck add: bij_is_inj inj_is_fun)
apply (auto simp add: left_inverse_bij right_inverse_bij)
done
qed
lemma prod_eqpoll_rel_cong:
assumes "A ââMâ C" "B ââMâ D" "M(A)" "M(C)" "M(B)" "M(D)"
shows "AÃB ââMâ CÃD"
using assms
proof (simp add: def_eqpoll_rel, safe, rename_tac g)
fix f g
assume "M(f)" "f â bij(A, C)" "M(g)" "g â bij(B, D)"
with assms
obtain h where "hâbij(AÃB, CÃD)" "M(h)"
using prod_bij_rel'[of f A C g B D] by simp
then
show "âf[M]. f â bij(A Ã B, C Ã D)"
by auto
qed
lemma inj_rel_disjoint_eqpoll_rel:
"[| f â injâMâ(A,B); A â© B = 0;M(f); M(A);M(B) |] ==> A ⪠(B - range(f)) ââMâ B"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule_tac c = "%x. if x â A then f`x else x"
and d = "%y. if y â range (f) then converse (f) `y else y"
in lam_bijective)
apply (blast intro!: if_type inj_is_fun [THEN apply_type])
apply (simp (no_asm_simp) add: inj_converse_fun [THEN apply_funtype])
apply (safe elim!: UnE')
apply (simp_all add: inj_is_fun [THEN apply_rangeI])
apply (blast intro: inj_converse_fun [THEN apply_type])
proof -
assume "f â inj(A, B)" "A â© B = 0" "M(f)" "M(A)" "M(B)"
then
show "M(λxâA ⪠(B - range(f)). if x â A then f ` x else x)"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº]
lam_replacement_iff_lam_closed lam_if_then_replacement2
by auto
qed
lemma Diff_sing_lepoll_rel:
"[| a â A; A â²âMâ succ(n); M(a); M(A); M(n) |] ==> A - {a} â²âMâ n"
apply (unfold succ_def)
apply (rule cons_lepoll_rel_consD)
apply (rule_tac [3] mem_not_refl)
apply (erule cons_Diff [THEN ssubst], simp_all)
done
lemma lepoll_rel_Diff_sing:
assumes A: "succ(n) â²âMâ A"
and types: "M(n)" "M(A)" "M(a)"
shows "n â²âMâ A - {a}"
proof -
have "cons(n,n) â²âMâ A" using A
by (unfold succ_def)
also from types
have "... â²âMâ cons(a, A-{a})"
by (blast intro: subset_imp_lepoll_rel)
finally have "cons(n,n) â²âMâ cons(a, A-{a})" by (simp_all add:types)
with types
show ?thesis
by (blast intro: cons_lepoll_rel_consD mem_irrefl)
qed
lemma Diff_sing_eqpoll_rel: "[| a â A; A ââMâ succ(n); M(a); M(A); M(n) |] ==> A - {a} ââMâ n"
by (blast intro!: eqpoll_relI
elim!: eqpoll_relE
intro: Diff_sing_lepoll_rel lepoll_rel_Diff_sing)
lemma lepoll_rel_1_is_sing: "[| A â²âMâ 1; a â A ;M(a); M(A) |] ==> A = {a}"
apply (frule Diff_sing_lepoll_rel, assumption+, simp)
apply (drule lepoll_rel_0_is_0, simp)
apply (blast elim: equalityE)
done
lemma Un_lepoll_rel_sum: "M(A) â¹ M(B) â¹ A ⪠B â²âMâ A+B"
apply (simp add: def_lepoll_rel)
apply (rule_tac x = "λxâA ⪠B. if xâA then Inl (x) else Inr (x)" in rexI)
apply (rule_tac d = "%z. snd (z)" in lam_injective)
apply force
apply (simp add: Inl_def Inr_def)
proof -
assume "M(A)" "M(B)"
then
show "M(λxâA ⪠B. if x â A then Inl(x) else Inr(x))"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº] if_then_Inj_replacement
by (rule_tac lam_closed) auto
qed
lemma well_ord_Un_M:
assumes "well_ord(X,R)" "well_ord(Y,S)"
and types: "M(X)" "M(R)" "M(Y)" "M(S)"
shows "âT[M]. well_ord(X ⪠Y, T)"
using assms
by (erule_tac well_ord_radd [THEN [3] Un_lepoll_rel_sum [THEN lepoll_rel_well_ord]])
(auto simp add: types)
lemma disj_Un_eqpoll_rel_sum: "M(A) â¹ M(B) â¹ A â© B = 0 â¹ A ⪠B ââMâ A + B"
apply (simp add: def_eqpoll_rel)
apply (rule_tac x = "λaâA ⪠B. if a â A then Inl (a) else Inr (a)" in rexI)
apply (rule_tac d = "%z. case (%x. x, %x. x, z)" in lam_bijective)
apply auto
proof -
assume "M(A)" "M(B)"
then
show "M(λxâA ⪠B. if x â A then Inl(x) else Inr(x))"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº] if_then_Inj_replacement
by (rule_tac lam_closed) auto
qed
lemma eqpoll_rel_imp_Finite_rel_iff: "A ââMâ B ==> M(A) â¹ M(B) â¹ Finite_rel(M,A) â· Finite_rel(M,B)"
apply (unfold Finite_rel_def)
apply (blast intro: eqpoll_rel_trans eqpoll_rel_sym)
done
lemma Finite_abs[simp]: assumes "M(A)" shows "Finite_rel(M,A) â· Finite(A)"
unfolding Finite_rel_def Finite_def
proof (simp, intro iffI)
assume "ânânat. A ââMâ n"
then
obtain n where "A ââMâ n" "nânat" by blast
with assms
show "ânânat. A â n"
unfolding eqpoll_def using nat_into_M by (auto simp add:def_eqpoll_rel)
next
fix n
assume "ânânat. A â n"
then
obtain n where "A â n" "nânat" by blast
moreover from this
obtain f where "f â bij(A,n)" unfolding eqpoll_def by auto
moreover
note assms
moreover from calculation
have "converse(f) â nâA" using bij_is_fun by simp
moreover from calculation
have "M(converse(f))" using transM[of _ "nâA"] by simp
moreover from calculation
have "M(f)" using bij_is_fun
fun_is_rel[of "f" A "λ_. n", THEN converse_converse]
converse_closed[of "converse(f)"] by simp
ultimately
show "ânânat. A ââMâ n"
by (force dest:nat_into_M simp add:def_eqpoll_rel)
qed
lemma lepoll_rel_nat_imp_Finite_rel:
assumes A: "A â²âMâ n" and n: "n â nat"
and types: "M(A)" "M(n)"
shows "Finite_rel(M,A)"
proof -
have "A â²âMâ n â¹ Finite_rel(M,A)" using n
proof (induct n)
case 0
hence "A = 0" by (rule lepoll_rel_0_is_0, simp_all add:types)
thus ?case by simp
next
case (succ n)
hence "A â²âMâ n ⨠A ââMâ succ(n)" by (blast dest: lepoll_rel_succ_disj intro:types)
thus ?case using succ by (auto simp add: Finite_rel_def types)
qed
thus ?thesis using A .
qed
lemma lesspoll_rel_nat_is_Finite_rel:
"A âºâMâ nat â¹ M(A) â¹ Finite_rel(M,A)"
apply (unfold Finite_rel_def)
apply (auto dest: ltD lesspoll_rel_cardinal_rel_lt
lesspoll_rel_imp_eqpoll_rel [THEN eqpoll_rel_sym])
done
lemma lepoll_rel_Finite_rel:
assumes Y: "Y â²âMâ X" and X: "Finite_rel(M,X)"
and types:"M(Y)" "M(X)"
shows "Finite_rel(M,Y)"
proof -
obtain n where n: "n â nat" "X ââMâ n" "M(n)" using X
by (auto simp add: Finite_rel_def)
have "Y â²âMâ X" by (rule Y)
also have "... ââMâ n" by (rule n)
finally have "Y â²âMâ n" by (simp_all add:types â¹M(n)âº)
thus ?thesis using n
by (simp add: lepoll_rel_nat_imp_Finite_rel types â¹M(n)⺠del:Finite_abs)
qed
lemma succ_lepoll_rel_imp_not_empty: "succ(x) â²âMâ y ==> M(x) â¹ M(y) â¹ y â 0"
by (fast dest!: lepoll_rel_0_is_0)
lemma eqpoll_rel_succ_imp_not_empty: "x ââMâ succ(n) ==> M(x) â¹ M(n) â¹ x â 0"
by (fast elim!: eqpoll_rel_sym [THEN eqpoll_rel_0_is_0, THEN succ_neq_0])
lemma Finite_subset_closed:
assumes "Finite(B)" "BâA" "M(A)"
shows "M(B)"
proof -
from â¹Finite(B)⺠â¹BâAâº
show ?thesis
proof(induct,simp)
case (cons x D)
with assms
have "M(D)" "xâA"
unfolding cons_def by auto
then
show ?case using transM[OF _ â¹M(A)âº] by simp
qed
qed
lemma Finite_Pow_abs:
assumes "Finite(A)" " M(A)"
shows "Pow(A) = Pow_rel(M,A)"
using Finite_subset_closed[OF subset_Finite] assms Pow_rel_char
by auto
lemma Finite_Pow_rel:
assumes "Finite(A)" "M(A)"
shows "Finite(Pow_rel(M,A))"
using Finite_Pow Finite_Pow_abs[symmetric] assms by simp
lemma Pow_rel_0 [simp]: "Pow_rel(M,0) = {0}"
using Finite_Pow_abs[of 0] by simp
lemma eqpoll_rel_imp_Finite: "A ââMâ B â¹ Finite(A) â¹ M(A) â¹ M(B) â¹ Finite(B)"
proof -
assume "A ââMâ B" "Finite(A)" "M(A)" "M(B)"
then obtain f n g where "fâbij(A,B)" "nânat" "gâbij(A,n)"
unfolding Finite_def eqpoll_def eqpoll_rel_def
using bij_rel_char
by auto
then
have "g O converse(f) â bij(B,n)"
using bij_converse_bij comp_bij by simp
with â¹nâ_âº
show"Finite(B)"
unfolding Finite_def eqpoll_def by auto
qed
lemma eqpoll_rel_imp_Finite_iff: "A ââMâ B â¹ M(A) â¹ M(B) â¹ Finite(A) â· Finite(B)"
using eqpoll_rel_imp_Finite eqpoll_rel_sym by force
end
end
ead>
Theory CardinalArith_Relative
sectionâ¹Relative, Choice-less Cardinal Arithmeticâº
theory CardinalArith_Relative
imports
Cardinal_Relative
begin
relativize functional "rvimage" "rvimage_rel" external
relationalize "rvimage_rel" "is_rvimage"
definition
csquare_lam :: "iâi" where
"csquare_lam(K) ⡠λâ¨x,yâ©âKÃK. â¨x ⪠y, x, yâ©"
relativize_tm "<fst(x) ⪠snd(x), fst(x), snd(x)>" "is_csquare_lam_body"
definition
is_csquare_lam :: "[iâo,i,i]âo" where
"is_csquare_lam(M,K,l) â¡ âK2[M]. cartprod(M,K,K,K2) â§
is_lambda(M,K2,is_csquare_lam_body(M),l)"
definition jump_cardinal_body :: "[iâo,i] â i" where
"jump_cardinal_body(M,X) â¡
{z . r â PowâMâ(X à X), M(z) ⧠M(r) ⧠well_ord(X, r) ⧠z = ordertype(X, r)} "
lemma (in M_cardinals) csquare_lam_closed[intro,simp]: "M(K) â¹ M(csquare_lam(K))"
using csquare_lam_replacement unfolding csquare_lam_def
by (rule lam_closed) (auto dest:transM)
locale M_pre_cardinal_arith = M_cardinals +
assumes
wfrec_pred_replacement:"M(A) â¹ M(r) â¹
wfrec_replacement(M, λx f z. z = f `` Order.pred(A, x, r), r)"
begin
lemma ord_iso_separation: "M(A) â¹ M(r) â¹ M(s) â¹
separation(M, λf. âxâA. âyâA. â¨x, yâ© â r â· â¨f ` x, f ` yâ© â s)"
using
lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
separation_in lam_replacement_fst lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
lam_replacement_identity lam_replacement_constant
by(rule_tac separation_ball,rule_tac separation_ball,simp_all,rule_tac separation_iff',simp_all)
end
locale M_cardinal_arith = M_pre_cardinal_arith +
assumes
ordertype_replacement :
"M(X) â¹ strong_replacement(M,λ x z . M(z) ⧠M(x) ⧠xâPow_rel(M,XÃX) ⧠well_ord(X, x) ⧠z=ordertype(X,x))"
and
strong_replacement_jc_body :
"strong_replacement(M,λ x z . M(z) ⧠M(x) ⧠z = jump_cardinal_body(M,x))"
lemmas (in M_cardinal_arith) surj_imp_inj_replacement =
surj_imp_inj_replacement1 surj_imp_inj_replacement2 surj_imp_inj_replacement4
lam_replacement_vimage_sing_fun[THEN lam_replacement_imp_strong_replacement]
relativize_tm "âx' y' x y. z = â¨â¨x', y'â©, x, y⩠⧠(â¨x', xâ© â r ⨠x' = x ⧠â¨y', yâ© â s)"
"is_rmultP"
relativize functional "rmult" "rmult_rel" external
relationalize "rmult_rel" "is_rmult"
lemma (in M_trivial) rmultP_abs [absolut]: "⦠M(r); M(s); M(z) ⧠⹠is_rmultP(M,s,r,z) â·
(âx' y' x y. z = â¨â¨x', y'â©, x, y⩠⧠(â¨x', xâ© â r ⨠x' = x ⧠â¨y', yâ© â s))"
unfolding is_rmultP_def by (auto dest:transM)
definition
is_csquare_rel :: "[iâo,i,i]âo" where
"is_csquare_rel(M,K,cs) â¡ âK2[M]. âla[M]. âmemK[M].
ârmKK[M]. ârmKK2[M].
cartprod(M,K,K,K2) ⧠is_csquare_lam(M,K,la) â§
membership(M,K,memK) ⧠is_rmult(M,K,memK,K,memK,rmKK) â§
is_rmult(M,K,memK,K2,rmKK,rmKK2) ⧠is_rvimage(M,K2,la,rmKK2,cs)"
context M_basic
begin
lemma rvimage_abs[absolut]:
assumes "M(A)" "M(f)" "M(r)" "M(z)"
shows "is_rvimage(M,A,f,r,z) â· z = rvimage(A,f,r)"
using assms transM[OF _ â¹M(A)âº]
unfolding is_rvimage_def rvimage_def
by auto
lemma rmult_abs [absolut]: "⦠M(A); M(r); M(B); M(s); M(z) ⧠â¹
is_rmult(M,A,r,B,s,z) â· z=rmult(A,r,B,s)"
using rmultP_abs transM[of _ "(A Ã B) Ã A Ã B"]
unfolding is_rmultP_def is_rmult_def rmult_def
by (auto del: iffI)
lemma csquare_lam_body_abs[absolut]: "M(x) â¹ M(z) â¹
is_csquare_lam_body(M,x,z) ⷠz = <fst(x) ⪠snd(x), fst(x), snd(x)>"
unfolding is_csquare_lam_body_def by (simp add:absolut)
lemma csquare_lam_abs[absolut]: "M(K) â¹ M(l) â¹
is_csquare_lam(M,K,l) â· l = (λxâKÃK. â¨fst(x) ⪠snd(x), fst(x), snd(x)â©)"
unfolding is_csquare_lam_def
using lambda_abs2[of "KÃK" "is_csquare_lam_body(M)"
"λx. â¨fst(x) ⪠snd(x), fst(x), snd(x)â©"]
unfolding Relation1_def by (simp add:absolut)
lemma csquare_lam_eq_lam:"csquare_lam(K) = (λzâKÃK. <fst(z) ⪠snd(z), fst(z), snd(z)>)"
proof -
have "(λâ¨x,yâ©âK à K. â¨x ⪠y, x, yâ©)`z =
(λzâKÃK. <fst(z) ⪠snd(z), fst(z), snd(z)>)`z" if "zâKÃK" for z
using that by auto
then
show ?thesis
unfolding csquare_lam_def
by simp
qed
end
context M_pre_cardinal_arith
begin
lemma csquare_rel_closed[intro,simp]: "M(K) â¹ M(csquare_rel(K))"
using csquare_lam_replacement unfolding csquare_rel_def
by (intro rvimage_closed lam_closed) (auto dest:transM)
lemma csquare_rel_abs[absolut]: "⦠M(K); M(cs)⧠â¹
is_csquare_rel(M,K,cs) â· cs = csquare_rel(K)"
unfolding is_csquare_rel_def csquare_rel_def
using csquare_lam_closed[unfolded csquare_lam_eq_lam]
by (simp add:absolut csquare_lam_eq_lam[unfolded csquare_lam_def])
end
relativize functional "csucc" "csucc_rel" external
relationalize "csucc_rel" "is_csucc"
synthesize "is_csucc" from_definition assuming "nonempty"
arity_theorem for "is_csucc_fm"
abbreviation
csucc_r :: "[i,iâo] â i" (â¹'(_â§+')â_ââº) where
"csucc_r(x,M) â¡ csucc_rel(M,x)"
abbreviation
csucc_r_set :: "[i,i] â i" (â¹'(_â§+')â_ââº) where
"csucc_r_set(x,M) â¡ csucc_rel(##M,x)"
context M_Perm
begin
rel_closed for "csucc"
using Least_closed'[of "λ L. M(L) ⧠CardâMâ(L) ⧠K < L"]
unfolding csucc_rel_def
by simp
is_iff_rel for "csucc"
using least_abs'[of "λ L. M(L) ⧠CardâMâ(L) ⧠K < L" res]
is_Card_iff
unfolding is_csucc_def csucc_rel_def
by (simp add:absolut)
end
notation csucc_rel (â¹csuccâ_â'(_')âº)
context M_cardinals
begin
lemma Card_rel_Union [simp,intro,TC]:
assumes A: "âx. xâA â¹ CardâMâ(x)" and
types:"M(A)"
shows "CardâMâ(â(A))"
proof (rule Card_relI)
show "Ord(âA)" using A
by (simp add: Card_rel_is_Ord types transM)
next
fix j
assume j: "j < âA"
moreover from this
have "M(j)" unfolding lt_def by (auto simp add:types dest:transM)
from j
have "âcâA. j â c ⧠CardâMâ(c)" using A types
unfolding lt_def
by (simp)
then
obtain c where c: "câA" "j < c" "CardâMâ(c)" "M(c)"
using Card_rel_is_Ord types unfolding lt_def
by (auto dest:transM)
with â¹M(j)âº
have jls: "j âºâMâ c"
by (simp add: lt_Card_rel_imp_lesspoll_rel types)
{ assume eqp: "j ââMâ âA"
have "c â²âMâ âA" using c
by (blast intro: subset_imp_lepoll_rel types)
also from types â¹M(j)âº
have "... ââMâ j" by (rule_tac eqpoll_rel_sym [OF eqp]) (simp_all add:types)
also have "... âºâMâ c" by (rule jls)
finally have "c âºâMâ c" by (simp_all add:â¹M(c)⺠â¹M(j)⺠types)
with â¹M(c)âº
have False
by (auto dest:lesspoll_rel_irrefl)
} thus "¬ j ââMâ âA" by blast
qed (simp_all add:types)
lemma in_Card_imp_lesspoll: "[| CardâMâ(K); b â K; M(K); M(b) |] ==> b âºâMâ K"
apply (unfold lesspoll_rel_def)
apply (simp add: Card_rel_iff_initial)
apply (fast intro!: le_imp_lepoll_rel ltI leI)
done
subsectionâ¹Cardinal additionâº
textâ¹Note (Paulson): Could omit proving the algebraic laws for cardinal addition and
multiplication. On finite cardinals these operations coincide with
addition and multiplication of natural numbers; on infinite cardinals they
coincide with union (maximum). Either way we get most laws for free.âº
subsubsectionâ¹Cardinal addition is commutativeâº
lemma sum_commute_eqpoll_rel: "M(A) â¹ M(B) â¹ A+B ââMâ B+A"
proof (simp add: def_eqpoll_rel, rule rexI)
show "(λzâA+B. case(Inr,Inl,z)) â bij(A+B, B+A)"
by (auto intro: lam_bijective [where d = "case(Inr,Inl)"])
assume "M(A)" "M(B)"
then
show "M(λzâA + B. case(Inr, Inl, z))"
using case_replacement1
by (rule_tac lam_closed) (auto dest:transM)
qed
lemma cadd_rel_commute: "M(i) â¹ M(j) â¹ i ââMâ j = j ââMâ i"
apply (unfold cadd_rel_def)
apply (auto intro: sum_commute_eqpoll_rel [THEN cardinal_rel_cong])
done
subsubsectionâ¹Cardinal addition is associativeâº
lemma sum_assoc_eqpoll_rel: "M(A) â¹ M(B) â¹ M(C) â¹ (A+B)+C ââMâ A+(B+C)"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule sum_assoc_bij)
using case_replacement2
by (rule_tac lam_closed) (auto dest:transM)
textâ¹Unconditional version requires ACâº
lemma well_ord_cadd_rel_assoc:
assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
and
types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
shows "(i ââMâ j) ââMâ k = i ââMâ (j ââMâ k)"
proof (simp add: assms cadd_rel_def, rule cardinal_rel_cong)
from types
have "|i + j|âMâ + k ââMâ (i + j) + k"
by (auto intro!: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl well_ord_radd i j)
also have "... ââMâ i + (j + k)"
by (rule sum_assoc_eqpoll_rel) (simp_all add:types)
also
have "... ââMâ i + |j + k|âMâ"
proof (auto intro!: sum_eqpoll_rel_cong intro:eqpoll_rel_refl simp add:types)
from types
have "|j + k|âMâ ââMâ j + k"
using well_ord_cardinal_rel_eqpoll_rel[OF well_ord_radd, OF j k]
by (simp)
with types
show "j + k ââMâ |j + k|âMâ"
using eqpoll_rel_sym by simp
qed
finally show "|i + j|âMâ + k ââMâ i + |j + k|âMâ" by (simp_all add:types)
qed (simp_all add:types)
subsubsectionâ¹0 is the identity for additionâº
lemma case_id_eq: "xâsum(A,B) â¹ case(λz . z, λz. z ,x) = snd(x)"
unfolding case_def cond_def by (auto simp:Inl_def Inr_def)
lemma lam_case_id: "(λzâ0 + A. case(λx. x, λy. y, z)) = (λzâ0 + A . snd(z))"
using case_id_eq by simp
lemma sum_0_eqpoll_rel: "M(A) â¹ 0+A ââMâ A"
apply (simp add:def_eqpoll_rel)
apply (rule rexI)
apply (rule bij_0_sum,subst lam_case_id)
using lam_replacement_snd[unfolded lam_replacement_def]
by (rule lam_closed)
(auto simp add:case_def cond_def Inr_def dest:transM)
lemma cadd_rel_0 [simp]: "CardâMâ(K) â¹ M(K) â¹ 0 ââMâ K = K"
apply (simp add: cadd_rel_def)
apply (simp add: sum_0_eqpoll_rel [THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
done
subsubsectionâ¹Addition by another cardinalâº
lemma sum_lepoll_rel_self: "M(A) â¹ M(B) â¹ A â²âMâ A+B"
proof (simp add: def_lepoll_rel, rule rexI)
show "(λxâA. Inl (x)) â inj(A, A + B)"
by (simp add: inj_def)
assume "M(A)" "M(B)"
then
show "M(λxâA. Inl(x))"
using Inl_replacement1 transM[OF _ â¹M(A)âº]
by (rule_tac lam_closed) (auto simp add: Inl_def)
qed
lemma cadd_rel_le_self:
assumes K: "CardâMâ(K)" and L: "Ord(L)" and
types:"M(K)" "M(L)"
shows "K ⤠(K ââMâ L)"
proof (simp add:types cadd_rel_def)
have "K ⤠|K|âMâ"
by (rule Card_rel_cardinal_rel_le [OF K]) (simp add:types)
moreover have "|K|âMâ ⤠|K + L|âMâ" using K L
by (blast intro: well_ord_lepoll_rel_imp_cardinal_rel_le sum_lepoll_rel_self
well_ord_radd well_ord_Memrel Card_rel_is_Ord types)
ultimately show "K ⤠|K + L|âMâ"
by (blast intro: le_trans)
qed
subsubsectionâ¹Monotonicity of additionâº
lemma sum_lepoll_rel_mono:
"[| A â²âMâ C; B â²âMâ D; M(A); M(B); M(C); M(D) |] ==> A + B â²âMâ C + D"
apply (simp add: def_lepoll_rel)
apply (elim rexE)
apply (rule_tac x = "λzâA+B. case (%w. Inl(f`w), %y. Inr(fa`y), z)" in rexI)
apply (rule_tac d = "case (%w. Inl(converse(f) `w), %y. Inr(converse(fa) ` y))"
in lam_injective)
apply (typecheck add: inj_is_fun, auto)
apply (rule_tac lam_closed, auto dest:transM intro:case_replacement4)
done
lemma cadd_rel_le_mono:
"[| K' ⤠K; L' ⤠L;M(K');M(K);M(L');M(L) |] ==> (K' ââMâ L') ⤠(K ââMâ L)"
apply (unfold cadd_rel_def)
apply (safe dest!: le_subset_iff [THEN iffD1])
apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
apply (blast intro: well_ord_radd well_ord_Memrel)
apply (auto intro: sum_lepoll_rel_mono subset_imp_lepoll_rel)
done
subsubsectionâ¹Addition of finite cardinals is "ordinary" additionâº
lemma sum_succ_eqpoll_rel: "M(A) â¹ M(B) â¹ succ(A)+B ââMâ succ(A+B)"
apply (simp add:def_eqpoll_rel)
apply (rule rexI)
apply (rule_tac c = "%z. if z=Inl (A) then A+B else z"
and d = "%z. if z=A+B then Inl (A) else z" in lam_bijective)
apply simp_all
apply (blast dest: sym [THEN eq_imp_not_mem] elim: mem_irrefl)+
apply(rule_tac lam_closed, auto dest:transM intro:if_then_range_replacement2)
done
lemma cadd_succ_lemma:
assumes "Ord(m)" "Ord(n)" and
types: "M(m)" "M(n)"
shows "succ(m) ââMâ n = |succ(m ââMâ n)|âMâ"
using types
proof (simp add: cadd_rel_def)
have [intro]: "m + n ââMâ |m + n|âMâ" using assms
by (blast intro: eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel well_ord_radd well_ord_Memrel)
have "|succ(m) + n|âMâ = |succ(m + n)|âMâ"
by (rule sum_succ_eqpoll_rel [THEN cardinal_rel_cong]) (simp_all add:types)
also have "... = |succ(|m + n|âMâ)|âMâ"
by (blast intro: succ_eqpoll_rel_cong cardinal_rel_cong types)
finally show "|succ(m) + n|âMâ = |succ(|m + n|âMâ)|âMâ" .
qed
lemma nat_cadd_rel_eq_add:
assumes m: "m â nat" and [simp]: "n â nat" shows"m ââMâ n = m +â©Ï n"
using m
proof (induct m)
case 0 thus ?case
using transM[OF _ M_nat]
by (auto simp add: nat_into_Card_rel)
next
case (succ m) thus ?case
using transM[OF _ M_nat]
by (simp add: cadd_succ_lemma nat_into_Card_rel Card_rel_cardinal_rel_eq)
qed
subsectionâ¹Cardinal multiplicationâº
subsubsectionâ¹Cardinal multiplication is commutativeâº
lemma prod_commute_eqpoll_rel: "M(A) â¹ M(B) â¹ A*B ââMâ B*A"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule_tac c = "%<x,y>.<y,x>" and d = "%<x,y>.<y,x>" in lam_bijective,
auto)
apply(rule_tac lam_closed, auto intro:swap_replacement dest:transM)
done
lemma cmult_rel_commute: "M(i) â¹ M(j) â¹ i ââMâ j = j ââMâ i"
apply (unfold cmult_rel_def)
apply (rule prod_commute_eqpoll_rel [THEN cardinal_rel_cong], simp_all)
done
subsubsectionâ¹Cardinal multiplication is associativeâº
lemma prod_assoc_eqpoll_rel: "M(A) â¹ M(B) â¹ M(C) â¹ (A*B)*C ââMâ A*(B*C)"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule prod_assoc_bij)
apply(rule_tac lam_closed, auto intro:assoc_replacement dest:transM)
done
textâ¹Unconditional version requires ACâº
lemma well_ord_cmult_rel_assoc:
assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
and
types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
shows "(i ââMâ j) ââMâ k = i ââMâ (j ââMâ k)"
proof (simp add: assms cmult_rel_def, rule cardinal_rel_cong)
have "|i * j|âMâ * k ââMâ (i * j) * k"
by (auto intro!: prod_eqpoll_rel_cong
well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl
well_ord_rmult i j simp add:types)
also have "... ââMâ i * (j * k)"
by (rule prod_assoc_eqpoll_rel, simp_all add:types)
also have "... ââMâ i * |j * k|âMâ"
by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
eqpoll_rel_refl well_ord_rmult j k eqpoll_rel_sym types)
finally show "|i * j|âMâ * k ââMâ i * |j * k|âMâ" by (simp add:types)
qed (simp_all add:types)
subsubsectionâ¹Cardinal multiplication distributes over additionâº
lemma sum_prod_distrib_eqpoll_rel: "M(A) â¹ M(B) â¹ M(C) â¹ (A+B)*C ââMâ (A*C)+(B*C)"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule sum_prod_distrib_bij)
apply(rule_tac lam_closed, auto intro:case_replacement5 dest:transM)
done
lemma well_ord_cadd_cmult_distrib:
assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
and
types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
shows "(i ââMâ j) ââMâ k = (i ââMâ k) ââMâ (j ââMâ k)"
proof (simp add: assms cadd_rel_def cmult_rel_def, rule cardinal_rel_cong)
have "|i + j|âMâ * k ââMâ (i + j) * k"
by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
eqpoll_rel_refl well_ord_radd i j types)
also have "... ââMâ i * k + j * k"
by (rule sum_prod_distrib_eqpoll_rel) (simp_all add:types)
also have "... ââMâ |i * k|âMâ + |j * k|âMâ"
by (blast intro: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
well_ord_rmult i j k eqpoll_rel_sym types)
finally show "|i + j|âMâ * k ââMâ |i * k|âMâ + |j * k|âMâ" by (simp add:types)
qed (simp_all add:types)
subsubsectionâ¹Multiplication by 0 yields 0âº
lemma prod_0_eqpoll_rel: "M(A) â¹ 0*A ââMâ 0"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule lam_bijective, auto)
done
lemma cmult_rel_0 [simp]: "M(i) â¹ 0 ââMâ i = 0"
by (simp add: cmult_rel_def prod_0_eqpoll_rel [THEN cardinal_rel_cong])
subsubsectionâ¹1 is the identity for multiplicationâº
lemma prod_singleton_eqpoll_rel: "M(x) â¹ M(A) â¹ {x}*A ââMâ A"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule singleton_prod_bij [THEN bij_converse_bij])
apply (rule converse_closed)
apply(rule_tac lam_closed, auto intro:prepend_replacement dest:transM)
done
lemma cmult_rel_1 [simp]: "CardâMâ(K) â¹ M(K) â¹ 1 ââMâ K = K"
apply (simp add: cmult_rel_def succ_def)
apply (simp add: prod_singleton_eqpoll_rel[THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
done
subsectionâ¹Some inequalities for multiplicationâº
lemma prod_square_lepoll_rel: "M(A) â¹ A â²âMâ A*A"
apply (simp add:def_lepoll_rel inj_def)
apply (rule_tac x = "λxâA. <x,x>" in rexI, simp)
apply(rule_tac lam_closed, auto intro:id_replacement dest:transM)
done
lemma cmult_rel_square_le: "CardâMâ(K) â¹ M(K) â¹ K ⤠K ââMâ K"
apply (unfold cmult_rel_def)
apply (rule le_trans)
apply (rule_tac [2] well_ord_lepoll_rel_imp_cardinal_rel_le)
apply (rule_tac [3] prod_square_lepoll_rel)
apply (simp add: le_refl Card_rel_is_Ord Card_rel_cardinal_rel_eq)
apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
apply simp_all
done
subsubsectionâ¹Multiplication by a non-zero cardinalâº
lemma prod_lepoll_rel_self: "b â B â¹ M(b) â¹ M(B) â¹ M(A) â¹ A â²âMâ A*B"
apply (simp add: def_lepoll_rel inj_def)
apply (rule_tac x = "λxâA. <x,b>" in rexI, simp)
apply(rule_tac lam_closed, auto intro:pospend_replacement dest:transM)
done
lemma cmult_rel_le_self:
"[| CardâMâ(K); Ord(L); 0<L; M(K);M(L) |] ==> K ⤠(K ââMâ L)"
apply (unfold cmult_rel_def)
apply (rule le_trans [OF Card_rel_cardinal_rel_le well_ord_lepoll_rel_imp_cardinal_rel_le])
apply assumption apply simp
apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
apply (auto intro: prod_lepoll_rel_self ltD)
done
subsubsectionâ¹Monotonicity of multiplicationâº
lemma prod_lepoll_rel_mono:
"[| A â²âMâ C; B â²âMâ D; M(A); M(B); M(C); M(D)|] ==> A * B â²âMâ C * D"
apply (simp add:def_lepoll_rel)
apply (elim rexE)
apply (rule_tac x = "lam <w,y>:A*B. <f`w, fa`y>" in rexI)
apply (rule_tac d = "%<w,y>. <converse (f) `w, converse (fa) `y>"
in lam_injective)
apply (typecheck add: inj_is_fun, auto)
apply(rule_tac lam_closed, auto intro:prod_fun_replacement dest:transM)
done
lemma cmult_rel_le_mono:
"[| K' ⤠K; L' ⤠L;M(K');M(K);M(L');M(L) |] ==> (K' ââMâ L') ⤠(K ââMâ L)"
apply (unfold cmult_rel_def)
apply (safe dest!: le_subset_iff [THEN iffD1])
apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
apply (blast intro: well_ord_rmult well_ord_Memrel)
apply (auto intro: prod_lepoll_rel_mono subset_imp_lepoll_rel)
done
subsectionâ¹Multiplication of finite cardinals is "ordinary" multiplicationâº
lemma prod_succ_eqpoll_rel: "M(A) â¹ M(B) â¹ succ(A)*B ââMâ B + A*B"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (rule_tac c = "λp. if fst(p)=A then Inl (snd(p)) else Inr (p)"
and d = "case (%y. <A,y>, %z. z)" in lam_bijective)
apply safe
apply (simp_all add: succI2 if_type mem_imp_not_eq)
apply(rule_tac lam_closed, auto intro:Inl_replacement2 dest:transM)
done
lemma cmult_rel_succ_lemma:
"[| Ord(m); Ord(n) ; M(m); M(n) |] ==> succ(m) ââMâ n = n ââMâ (m ââMâ n)"
apply (simp add: cmult_rel_def cadd_rel_def)
apply (rule prod_succ_eqpoll_rel [THEN cardinal_rel_cong, THEN trans], simp_all)
apply (rule cardinal_rel_cong [symmetric], simp_all)
apply (rule sum_eqpoll_rel_cong [OF eqpoll_rel_refl well_ord_cardinal_rel_eqpoll_rel], assumption)
apply (blast intro: well_ord_rmult well_ord_Memrel)
apply simp_all
done
lemma nat_cmult_rel_eq_mult: "[| m â nat; n â nat |] ==> m ââMâ n = m#*n"
using transM[OF _ M_nat]
apply (induct_tac m)
apply (simp_all add: cmult_rel_succ_lemma nat_cadd_rel_eq_add)
done
lemma cmult_rel_2: "CardâMâ(n) â¹ M(n) â¹ 2 ââMâ n = n ââMâ n"
by (simp add: cmult_rel_succ_lemma Card_rel_is_Ord cadd_rel_commute [of _ 0])
lemma sum_lepoll_rel_prod:
assumes C: "2 â²âMâ C" and
types:"M(C)" "M(B)"
shows "B+B â²âMâ C*B"
proof -
have "B+B â²âMâ 2*B"
by (simp add: sum_eq_2_times types)
also have "... â²âMâ C*B"
by (blast intro: prod_lepoll_rel_mono lepoll_rel_refl C types)
finally show "B+B â²âMâ C*B" by (simp_all add:types)
qed
lemma lepoll_imp_sum_lepoll_prod: "[| A â²âMâ B; 2 â²âMâ A; M(A) ;M(B) |] ==> A+B â²âMâ A*B"
by (blast intro: sum_lepoll_rel_mono sum_lepoll_rel_prod lepoll_rel_trans lepoll_rel_refl)
end
subsectionâ¹Infinite Cardinals are Limit Ordinalsâº
context M_pre_cardinal_arith
begin
lemma nat_cons_lepoll_rel: "nat â²âMâ A â¹ M(A) â¹ M(u) ==> cons(u,A) â²âMâ A"
apply (simp add: def_lepoll_rel)
apply (erule rexE)
apply (rule_tac x =
"λzâcons (u,A).
if z=u then f`0
else if z â range (f) then f`succ (converse (f) `z) else z"
in rexI)
apply (rule_tac d =
"%y. if y â range(f) then nat_case (u, %z. f`z, converse(f) `y)
else y"
in lam_injective)
apply (fast intro!: if_type apply_type intro: inj_is_fun inj_converse_fun)
apply (simp add: inj_is_fun [THEN apply_rangeI]
inj_converse_fun [THEN apply_rangeI]
inj_converse_fun [THEN apply_funtype])
proof -
fix f
assume "M(A)" "M(f)" "M(u)"
then
show "M(λzâcons(u, A). if z = u then f ` 0 else if z â range(f) then f ` succ(converse(f) ` z) else z)"
using if_then_range_replacement transM[OF _ â¹M(A)âº]
by (rule_tac lam_closed, auto)
qed
lemma nat_cons_eqpoll_rel: "nat â²âMâ A ==> M(A) â¹ M(u) â¹ cons(u,A) ââMâ A"
apply (erule nat_cons_lepoll_rel [THEN eqpoll_relI], assumption+)
apply (rule subset_consI [THEN subset_imp_lepoll_rel], simp_all)
done
lemma nat_succ_eqpoll_rel: "nat â A ==> M(A) â¹ succ(A) ââMâ A"
apply (unfold succ_def)
apply (erule subset_imp_lepoll_rel [THEN nat_cons_eqpoll_rel], simp_all)
done
lemma InfCard_rel_nat: "InfCardâMâ(nat)"
apply (simp add: InfCard_rel_def)
apply (blast intro: Card_rel_nat Card_rel_is_Ord)
done
lemma InfCard_rel_is_Card_rel: "M(K) â¹ InfCardâMâ(K) â¹ CardâMâ(K)"
apply (simp add: InfCard_rel_def)
done
lemma InfCard_rel_Un:
"[| InfCardâMâ(K); CardâMâ(L); M(K); M(L) |] ==> InfCardâMâ(K ⪠L)"
apply (simp add: InfCard_rel_def)
apply (simp add: Card_rel_Un Un_upper1_le [THEN [2] le_trans] Card_rel_is_Ord)
done
lemma InfCard_rel_is_Limit: "InfCardâMâ(K) ==> M(K) â¹ Limit(K)"
apply (simp add: InfCard_rel_def)
apply (erule conjE)
apply (frule Card_rel_is_Ord, assumption)
apply (rule ltI [THEN non_succ_LimitI])
apply (erule le_imp_subset [THEN subsetD])
apply (safe dest!: Limit_nat [THEN Limit_le_succD])
apply (unfold Card_rel_def)
apply (drule trans)
apply (erule le_imp_subset [THEN nat_succ_eqpoll_rel, THEN cardinal_rel_cong], simp_all)
apply (erule Ord_cardinal_rel_le [THEN lt_trans2, THEN lt_irrefl], assumption)
apply (rule le_eqI) prefer 2
apply (rule Ord_cardinal_rel, assumption+)
done
end
lemma (in M_ordertype) ordertype_abs[absolut]:
assumes "wellordered(M,A,r)" "M(A)" "M(r)" "M(i)"
shows "otype(M,A,r,i) â· i = ordertype(A,r)"
proof (intro iffI)
note assms
moreover
assume "otype(M, A, r, i)"
moreover from calculation
obtain f j where "M(f)" "M(j)" "Ord(j)" "f â â¨A, râ© â
â¨j, Memrel(j)â©"
using ordertype_exists[of A r] by auto
moreover from calculation
have "âf[M]. f â â¨A, râ© â
â¨j, Memrel(j)â©" by auto
moreover
have "âf[M]. f â â¨A, râ© â
â¨i, Memrel(i)â©"
proof -
note calculation
moreover from this
obtain h where "omap(M, A, r, h)" "M(h)"
using omap_exists by auto
moreover from calculation
have "h â â¨A, râ© â
â¨i, Memrel(i)â©"
using omap_ord_iso obase_equals by simp
moreover from calculation
have "h O converse(f) â â¨j, Memrel(j)â© â
â¨i, Memrel(i)â©"
using ord_iso_sym ord_iso_trans by blast
moreover from calculation
have "i=j"
using Ord_iso_implies_eq[of j i "h O converse(f)"]
Ord_otype[OF _ well_ord_is_trans_on] by simp
ultimately
show ?thesis by simp
qed
ultimately
show "i = ordertype(A, r)"
by (force intro:ordertypes_are_absolute[of A r _ i]
simp add:Ord_otype[OF _ well_ord_is_trans_on])
next
note assms
moreover
assume "i = ordertype(A, r)"
moreover from calculation
obtain h where "omap(M, A, r, h)" "M(h)"
using omap_exists by auto
moreover from calculation
obtain j where "otype(M,A,r,j)" "M(j)"
using otype_exists by auto
moreover from calculation
have "h â â¨A, râ© â
â¨j, Memrel(j)â©"
using omap_ord_iso_otype by simp
moreover from calculation
obtain f where "f â â¨A, râ© â
â¨i, Memrel(i)â©"
using ordertype_ord_iso by auto
moreover
have "j=i"
proof -
note calculation
moreover from this
have "h O converse(f) â â¨i, Memrel(i)â© â
â¨j, Memrel(j)â©"
using ord_iso_sym ord_iso_trans by blast
moreover from calculation
have "Ord(i)" using Ord_ordertype by simp
ultimately
show "j=i"
using Ord_iso_implies_eq[of i j "h O converse(f)"]
Ord_otype[OF _ well_ord_is_trans_on] by simp
qed
ultimately
show "otype(M, A, r, i)" by simp
qed
lemma (in M_ordertype) ordertype_closed[intro,simp]: "⦠wellordered(M,A,r);M(A);M(r)⧠⹠M(ordertype(A,r))"
using ordertype_exists ordertypes_are_absolute by blast
relationalize "transitive_rel" "is_transitive" external
synthesize "is_transitive" from_definition assuming "nonempty"
arity_theorem for "is_transitive_fm"
lemma (in M_trivial) is_transitive_iff_transitive_rel:
"M(A)â¹ M(r) â¹ transitive_rel(M, A, r) â· is_transitive(M,A, r)"
unfolding transitive_rel_def is_transitive_def by simp
relationalize "linear_rel" "is_linear" external
synthesize "is_linear" from_definition assuming "nonempty"
arity_theorem for "is_linear_fm"
lemma (in M_trivial) is_linear_iff_linear_rel:
"M(A)â¹ M(r) â¹ is_linear(M,A, r) â· linear_rel(M, A, r)"
unfolding linear_rel_def is_linear_def by simp
relationalize "wellfounded_on" "is_wellfounded_on" external
synthesize "is_wellfounded_on" from_definition assuming "nonempty"
arity_theorem for "is_wellfounded_on_fm"
lemma (in M_trivial) is_wellfounded_on_iff_wellfounded_on:
"M(A)â¹ M(r) â¹ is_wellfounded_on(M,A, r) â· wellfounded_on(M, A, r)"
unfolding wellfounded_on_def is_wellfounded_on_def by simp
definition
is_well_ord :: "[i=>o,i,i]=>o" where
"is_well_ord(M,A,r) ==
is_transitive(M,A,r) ⧠is_linear(M,A,r) ⧠is_wellfounded_on(M,A,r)"
lemma (in M_trivial) is_well_ord_iff_wellordered:
"M(A)â¹ M(r) â¹ is_well_ord(M,A, r) â· wellordered(M, A, r)"
using is_wellfounded_on_iff_wellfounded_on is_linear_iff_linear_rel
is_transitive_iff_transitive_rel
unfolding wellordered_def is_well_ord_def by simp
reldb_add relational "well_ord" "is_well_ord"
reldb_add functional "well_ord" "well_ord"
synthesize "is_well_ord" from_definition assuming "nonempty"
arity_theorem for "is_well_ord_fm"
reldb_add relational "Order.pred" "pred_set"
reldb_add functional "Order.pred" "Order.pred"
relativize functional "ord_iso" "ord_iso_rel" external
relationalize "ord_iso_rel" "is_ord_iso"
context M_pre_cardinal_arith
begin
is_iff_rel for "ord_iso"
using bij_rel_iff
unfolding is_ord_iso_def ord_iso_rel_def
by simp
rel_closed for "ord_iso"
using ord_iso_separation unfolding ord_iso_rel_def
by simp
end
synthesize "is_ord_iso" from_definition assuming "nonempty"
lemma is_lambda_iff_sats[iff_sats]:
assumes is_F_iff_sats:
"!!a0 a1 a2.
[|a0âAa; a1âAa; a2âAa|]
==> is_F(a1, a0) â· sats(Aa, is_F_fm, Cons(a0,Cons(a1,Cons(a2,env))))"
shows
"nth(A, env) = Ab â¹
nth(r, env) = ra â¹
A â nat â¹
r â nat â¹
env â list(Aa) â¹
is_lambda(##Aa, Ab, is_F, ra) ⷠAa, env ⨠lambda_fm(is_F_fm,A, r)"
using sats_lambda_fm[OF assms, of A r] by simp
lemma sats_is_wfrec_fm':
assumes MH_iff_sats:
"!!a0 a1 a2 a3 a4.
[|a0âA; a1âA; a2âA; a3âA; a4âA|]
==> MH(a2, a1, a0) â· sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
shows
"[|x â nat; y â nat; z â nat; env â list(A); 0 â A|]
==> sats(A, is_wfrec_fm(p,x,y,z), env) â·
is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
using MH_iff_sats [THEN iff_sym] nth_closed sats_is_recfun_fm
by (simp add: is_wfrec_fm_def is_wfrec_def) blast
lemma is_wfrec_iff_sats'[iff_sats]:
assumes MH_iff_sats:
"!!a0 a1 a2 a3 a4.
[|a0âAa; a1âAa; a2âAa; a3âAa; a4âAa|]
==> MH(a2, a1, a0) â· sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
"nth(x, env) = xx" "nth(y, env) = yy" "nth(z, env) = zz"
"x â nat" "y â nat" "z â nat" "env â list(Aa)" "0 â Aa"
shows
"is_wfrec(##Aa, MH, xx, yy, zz) ⷠAa, env ⨠is_wfrec_fm(p,x,y,z)"
using assms(2-4) sats_is_wfrec_fm'[OF assms(1,5-9)] by simp
lemma is_wfrec_on_iff_sats[iff_sats]:
assumes MH_iff_sats:
"!!a0 a1 a2 a3 a4.
[|a0âAa; a1âAa; a2âAa; a3âAa; a4âAa|]
==> MH(a2, a1, a0) â· sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
shows
"nth(x, env) = xx â¹
nth(y, env) = yy â¹
nth(z, env) = zz â¹
x â nat â¹
y â nat â¹
z â nat â¹
env â list(Aa) â¹
0 â Aa â¹ is_wfrec_on(##Aa, MH, aa,xx, yy, zz) â· Aa, env ⨠is_wfrec_fm(p,x,y,z)"
using assms sats_is_wfrec_fm'[OF assms] unfolding is_wfrec_on_def by simp
lemma trans_on_iff_trans: "trans[A](r) â· trans(r â© AÃA)"
unfolding trans_on_def trans_def by auto
lemma trans_on_subset: "trans[A](r) â¹ B â A â¹ trans[B](r)"
unfolding trans_on_def
by auto
lemma relation_Int: "relation(r â© BÃB)"
unfolding relation_def
by auto
textâ¹Discipline for \<^term>â¹ordermapâºâº
relativize functional "ordermap" "ordermap_rel" external
relationalize "ordermap_rel" "is_ordermap"
context M_pre_cardinal_arith
begin
lemma wfrec_on_pred_eq:
assumes "r â Pow(AÃA)" "M(A)" "M(r)"
shows "wfrec[A](r, x, λx f. f `` Order.pred(A, x, r)) = wfrec(r, x, λx f. f `` Order.pred(A, x, r))"
proof -
from â¹r â Pow(AÃA)âº
have "r â© AÃA = r" by auto
moreover from this
show ?thesis
unfolding wfrec_on_def by simp
qed
lemma wfrec_on_pred_closed:
assumes "wf[A](r)" "trans[A](r)" "r â Pow(AÃA)" "M(A)" "M(r)" "x â A"
shows "M(wfrec(r, x, λx f. f `` Order.pred(A, x, r)))"
proof -
from assms
have "wfrec[A](r, x, λx f. f `` Order.pred(A, x, r)) = wfrec(r, x, λx f. f `` Order.pred(A, x, r))"
using wfrec_on_pred_eq by simp
moreover from assms
have "M(wfrec(r, x, λx f. f `` Order.pred(A, x, r)))"
using wfrec_pred_replacement wf_on_imp_wf trans_on_imp_trans subset_Sigma_imp_relation
by (rule_tac MH="λx f b. âa[M]. image(M, f, a, b) ⧠pred_set(M, A, x, r, a)" in trans_wfrec_closed)
(auto dest:transM simp:relation2_def)
ultimately
show ?thesis by simp
qed
lemma wfrec_on_pred_closed':
assumes "wf[A](r)" "trans[A](r)" "r â Pow(AÃA)" "M(A)" "M(r)" "x â A"
shows "M(wfrec[A](r, x, λx f. f `` Order.pred(A, x, r)))"
using assms wfrec_on_pred_closed wfrec_on_pred_eq by simp
lemma ordermap_rel_closed':
assumes "wf[A](r)" "trans[A](r)" "r â Pow(AÃA)" "M(A)" "M(r)"
shows "M(ordermap_rel(M, A, r))"
proof -
from assms
have "r â© AÃA = r" by auto
with assms have "wf(r)" "trans(r)" "relation(r)"
unfolding wf_on_def using trans_on_iff_trans relation_def by auto
then
have 1:"â x z . M(x) â¹ M(z) â¹
(ây[M]. pair(M, x, y, z) ⧠is_wfrec(M, λx f z. z = f `` Order.pred(A, x, r), r, x, y))
â·
z = <x,wfrec(r,x,λx f. f `` Order.pred(A, x, r))>"
using trans_wfrec_abs[of r,where
H="λx f. f `` Order.pred(A, x, r)" and
MH="λx f z . z= f `` Order.pred(A, x, r)",simplified] assms
wfrec_pred_replacement unfolding relation2_def
by auto
then
have "strong_replacement(M,λx z. z = <x,wfrec(r,x,λx f. f `` Order.pred(A, x, r))>)"
using strong_replacement_cong[of M,OF 1,THEN iffD1,OF _ _
wfrec_pred_replacement[unfolded wfrec_replacement_def]] assms by simp
then show ?thesis
using Pow_iff assms
unfolding ordermap_rel_def
apply(subst lam_cong[OF refl wfrec_on_pred_eq],simp_all)
using wfrec_on_pred_closed lam_closed
by simp
qed
lemma ordermap_rel_closed[intro,simp]:
assumes "wf[A](r)" "trans[A](r)" "r â Pow(AÃA)"
shows "M(A) â¹ M(r) â¹ M(ordermap_rel(M, A, r))"
using ordermap_rel_closed' assms by simp
lemma is_ordermap_iff:
assumes "r â Pow(AÃA)" "wf[A](r)" "trans[A](r)"
"M(A)" "M(r)" "M(res)"
shows "is_ordermap(M, A, r, res) â· res = ordermap_rel(M, A, r)"
proof -
from â¹r â Pow(AÃA)âº
have "r â© AÃA = r" by auto
with assms have 1:"wf(r)" "trans(r)" "relation(r)"
unfolding wf_on_def using trans_on_iff_trans relation_def by auto
from assms
have "r â© AÃA = r" "r â AÃA" "<x,y> â r â¹ xâA ⧠yâA" for x y by auto
then
show ?thesis
using ordermap_rel_closed[of r A] assms wfrec_on_pred_closed wfrec_pred_replacement 1
unfolding is_ordermap_def ordermap_rel_def
apply (rule_tac lambda_abs2)
apply (simp_all add:Relation1_def)
apply clarify
apply (rule trans_wfrec_on_abs)
apply (auto dest:transM simp add: relation_Int relation2_def)
by(rule_tac wfrec_on_pred_closed'[of A r],auto)
qed
end
synthesize "is_ordermap" from_definition assuming "nonempty"
textâ¹Discipline for \<^term>â¹ordertypeâºâº
relativize functional "ordertype" "ordertype_rel" external
relationalize "ordertype_rel" "is_ordertype"
context M_pre_cardinal_arith
begin
lemma is_ordertype_iff:
assumes "r â Pow(AÃA)" "wf[A](r)" "trans[A](r)"
shows "M(A) â¹ M(r) â¹ M(res) â¹ is_ordertype(M, A, r, res) â· res = ordertype_rel(M, A, r)"
using assms is_ordermap_iff[of r A] trans_on_iff_trans
ordermap_rel_closed[of A r]
unfolding is_ordertype_def ordertype_rel_def wf_on_def by simp
lemma is_ordertype_iff':
assumes "r â Pow_rel(M,AÃA)" "well_ord(A,r)"
shows "M(A) â¹ M(r) â¹ M(res) â¹ is_ordertype(M, A, r, res) â· res = ordertype_rel(M, A, r)"
using assms is_ordertype_iff Pow_rel_char
unfolding well_ord_def part_ord_def tot_ord_def by simp
lemma is_ordertype_iff'':
assumes "well_ord(A,r)" "râAÃA"
shows "M(A) â¹ M(r) â¹ M(res) â¹ is_ordertype(M, A, r, res) â· res = ordertype_rel(M, A, r)"
using assms is_ordertype_iff
unfolding well_ord_def part_ord_def tot_ord_def by simp
end
synthesize "is_ordertype" from_definition assuming "nonempty"
definition
jump_cardinal' :: "iâi" where
"jump_cardinal'(K) â¡
âXâPow(K). {z. r â Pow(X*X), well_ord(X,r) & z = ordertype(X,r)}"
relativize functional "jump_cardinal'" "jump_cardinal'_rel" external
relationalize "jump_cardinal'_rel" "is_jump_cardinal'"
synthesize "is_jump_cardinal'" from_definition assuming "nonempty"
arity_theorem for "is_jump_cardinal'_fm"
definition jump_cardinal_body' where
"jump_cardinal_body'(X) â¡ {z . r â Pow(X à X), well_ord(X, r) ⧠z = ordertype(X, r)}"
relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel" external
relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'"
synthesize "is_jump_cardinal_body'" from_definition assuming "nonempty"
arity_theorem for "is_jump_cardinal_body'_fm"
context M_pre_cardinal_arith
begin
lemma ordertype_rel_closed':
assumes "wf[A](r)" "trans[A](r)" "r â Pow(AÃA)" "M(r)" "M(A)"
shows "M(ordertype_rel(M,A,r))"
unfolding ordertype_rel_def
using ordermap_rel_closed image_closed assms by simp
lemma ordertype_rel_closed[intro,simp]:
assumes "well_ord(A,r)" "r â Pow_rel(M,AÃA)" "M(A)"
shows "M(ordertype_rel(M,A,r))"
using assms Pow_rel_char ordertype_rel_closed'
unfolding well_ord_def tot_ord_def part_ord_def
by simp
lemma ordertype_rel_abs:
assumes "wellordered(M,X,r)" "M(X)" "M(r)"
shows "ordertype_rel(M,X,r) = ordertype(X,r)"
using assms ordertypes_are_absolute[of X r]
unfolding ordertype_def ordertype_rel_def ordermap_rel_def ordermap_def
by simp
lemma univalent_aux1: "M(X) â¹ univalent(M,Pow_rel(M,XÃX),
λr z. M(z) ⧠M(r) ⧠râPow_rel(M,XÃX) ⧠is_well_ord(M, X, r) ⧠is_ordertype(M, X, r, z))"
using is_well_ord_iff_wellordered
is_ordertype_iff[of _ X]
trans_on_subset[OF well_ord_is_trans_on]
well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
unfolding univalent_def
by (simp)
lemma jump_cardinal_body_eq :
"M(X) â¹ jump_cardinal_body(M,X) = jump_cardinal_body'_rel(M,X)"
unfolding jump_cardinal_body_def jump_cardinal_body'_rel_def
using ordertype_rel_abs
by auto
end
context M_cardinal_arith
begin
lemma jump_cardinal_closed_aux1:
assumes "M(X)"
shows
"M(jump_cardinal_body(M,X))"
unfolding jump_cardinal_body_def
using â¹M(X)⺠ordertype_rel_abs
ordertype_replacement[OF â¹M(X)âº] univalent_aux1[OF â¹M(X)âº]
strong_replacement_closed[where A="PowâMâ(X Ã X)" and
P="λ r z . M(z) ⧠M(r) ⧠r â PowâMâ(X à X) ⧠well_ord(X, r) ⧠z = ordertype(X, r)"]
by auto
lemma univalent_jc_body: "M(X) ⹠univalent(M,X,λ x z . M(z) ⧠M(x) ⧠z = jump_cardinal_body(M,x))"
using transM[of _ X] jump_cardinal_closed_aux1 by auto
lemma jump_cardinal_body_closed:
assumes "M(K)"
shows "M({a . X â PowâMâ(K), M(a) ⧠M(X) ⧠a = jump_cardinal_body(M,X)})"
using assms univalent_jc_body jump_cardinal_closed_aux1 strong_replacement_jc_body
by simp
rel_closed for "jump_cardinal'"
using jump_cardinal_body_closed ordertype_rel_abs
unfolding jump_cardinal_body_def jump_cardinal'_rel_def
by simp
is_iff_rel for "jump_cardinal'"
proof -
assume types: "M(K)" "M(res)"
have "is_Replace(M, Pow_rel(M,XÃX), λr z. M(z) ⧠M(r) ⧠is_well_ord(M, X, r) ⧠is_ordertype(M, X, r, z),
a) â· a = {z . r â Pow_rel(M,XÃX), M(z) ⧠M(r) ⧠is_well_ord(M,X,r) ⧠is_ordertype(M, X, r, z)}"
if "M(X)" "M(a)" for X a
using that univalent_aux1
by (rule_tac Replace_abs) (simp_all)
then
have "is_Replace(M, Pow_rel(M,XÃX), λr z. M(z) ⧠M(r) ⧠is_well_ord(M, X, r) ⧠is_ordertype(M, X, r, z),
a) â· a = {z . r â Pow_rel(M,XÃX), M(z) ⧠M(r) ⧠well_ord(X, r) ⧠z = ordertype_rel(M, X, r)}"
if "M(X)" "M(a)" for X a
using that univalent_aux1 is_ordertype_iff' is_well_ord_iff_wellordered well_ord_abs by auto
moreover
have "is_Replace(M, d, λX a. M(a) ⧠M(X) â§
a = {z . r â PowâMâ(X à X), M(z) ⧠M(r) ⧠well_ord(X, r) ⧠z = ordertype(X, r)}, e)
â·
e ={a . X â d, M(a) ⧠M(X) ⧠a = jump_cardinal_body(M,X)}"
if "M(d)" "M(e)" for d e
using jump_cardinal_closed_aux1 that
unfolding jump_cardinal_body_def
by (rule_tac Replace_abs) simp_all
ultimately
show ?thesis
using Pow_rel_iff jump_cardinal_body_closed[of K] ordertype_rel_abs
unfolding is_jump_cardinal'_def jump_cardinal'_rel_def jump_cardinal_body_def
by (simp add: types)
qed
end
context M_cardinal_arith
begin
lemma (in M_ordertype) ordermap_closed[intro,simp]:
assumes "wellordered(M,A,r)" and types:"M(A)" "M(r)"
shows "M(ordermap(A,r))"
proof -
note assms
moreover from this
obtain i f where "Ord(i)" "f â ord_iso(A, r, i, Memrel(i))"
"M(i)" "M(f)" using ordertype_exists by blast
moreover from calculation
have "i = ordertype(A,r)" using ordertypes_are_absolute by force
moreover from calculation
have "ordermap(A,r) â ord_iso(A, r, i, Memrel(i))"
using ordertype_ord_iso by simp
ultimately
have "f = ordermap(A,r)" using well_ord_iso_unique by fastforce
with â¹M(f)âº
show ?thesis by simp
qed
lemma ordermap_eqpoll_pred:
"[| well_ord(A,r); x â A ; M(A);M(r);M(x)|] ==> ordermap(A,r)`x ââMâ Order.pred(A,x,r)"
apply (simp add: def_eqpoll_rel)
apply (rule rexI)
apply (simp add: ordermap_eq_image well_ord_is_wf)
apply (erule ordermap_bij [THEN bij_is_inj, THEN restrict_bij,
THEN bij_converse_bij])
apply (rule pred_subset, simp)
done
textâ¹Kunen: "each \<^term>â¹â¨x,yâ© â K à K⺠has no more than \<^term>â¹z à z⺠predecessors..." (page 29)âº
lemma ordermap_csquare_le:
assumes K: "Limit(K)" and x: "x<K" and y: " y<K"
and types: "M(K)" "M(x)" "M(y)"
shows "|ordermap(K à K, csquare_rel(K)) ` â¨x,yâ©|âMâ ⤠|succ(succ(x ⪠y))|âMâ ââMâ |succ(succ(x ⪠y))|âMâ"
using types
proof (simp add: cmult_rel_def, rule_tac well_ord_lepoll_rel_imp_cardinal_rel_le)
let ?z="succ(x ⪠y)"
show "well_ord(|succ(?z)|âMâ Ã |succ(?z)|âMâ,
rmult(|succ(?z)|âMâ, Memrel(|succ(?z)|âMâ), |succ(?z)|âMâ, Memrel(|succ(?z)|âMâ)))"
by (blast intro: well_ord_Memrel well_ord_rmult types)
next
let ?z="succ(x ⪠y)"
have zK: "?z<K" using x y K
by (blast intro: Un_least_lt Limit_has_succ)
hence oz: "Ord(?z)" by (elim ltE)
from assms
have Mom:"M(ordermap(K Ã K, csquare_rel(K)))"
using well_ord_csquare Limit_is_Ord by fastforce
then
have "ordermap(K à K, csquare_rel(K)) ` â¨x,yâ© â²âMâ ordermap(K à K, csquare_rel(K)) ` â¨?z,?zâ©"
by (blast intro: ordermap_z_lt leI le_imp_lepoll_rel K x y types)
also have "... ââMâ Order.pred(K à K, â¨?z,?zâ©, csquare_rel(K))"
proof (rule ordermap_eqpoll_pred)
show "well_ord(K Ã K, csquare_rel(K))" using K
by (rule Limit_is_Ord [THEN well_ord_csquare])
next
show "â¨?z, ?zâ© â K à K" using zK
by (blast intro: ltD)
qed (simp_all add:types)
also have "... â²âMâ succ(?z) à succ(?z)" using zK
by (rule_tac pred_csquare_subset [THEN subset_imp_lepoll_rel]) (simp_all add:types)
also have "... ââMâ |succ(?z)|âMâ Ã |succ(?z)|âMâ" using oz
by (blast intro: prod_eqpoll_rel_cong Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
finally show "ordermap(K à K, csquare_rel(K)) ` â¨x,yâ© â²âMâ |succ(?z)|âMâ à |succ(?z)|âMâ"
by (simp_all add:types Mom)
from Mom
show "M(ordermap(K à K, csquare_rel(K)) ` â¨x, yâ©)" by (simp_all add:types)
qed (simp_all add:types)
textâ¹Kunen: "... so the order type is â¹â¤âº K"âº
lemma ordertype_csquare_le_M:
assumes IK: "InfCardâMâ(K)" and eq: "ây. yâK â¹ InfCardâMâ(y) â¹ M(y) â¹ y ââMâ y = y"
and types: "M(K)"
shows "ordertype(K*K, csquare_rel(K)) ⤠K"
proof -
have CK: "CardâMâ(K)" using IK by (rule_tac InfCard_rel_is_Card_rel) (simp_all add:types)
hence OK: "Ord(K)" by (rule Card_rel_is_Ord) (simp_all add:types)
moreover have "Ord(ordertype(K Ã K, csquare_rel(K)))" using OK
by (rule well_ord_csquare [THEN Ord_ordertype])
ultimately show ?thesis
proof (rule all_lt_imp_le)
fix i
assume i:"i < ordertype(K Ã K, csquare_rel(K))"
hence Oi: "Ord(i)" by (elim ltE)
obtain x y where x: "x â K" and y: "y â K"
and ieq: "i = ordermap(K à K, csquare_rel(K)) ` â¨x,yâ©"
using i by (auto simp add: ordertype_unfold elim: ltE)
hence xy: "Ord(x)" "Ord(y)" "x < K" "y < K" using OK
by (blast intro: Ord_in_Ord ltI)+
hence ou: "Ord(x ⪠y)"
by (simp)
from OK types
have "M(ordertype(K Ã K, csquare_rel(K)))"
using well_ord_csquare by fastforce
with i x y types
have types': "M(K)" "M(i)" "M(x)" "M(y)"
using types by (auto dest:transM ltD)
show "i < K"
proof (rule Card_rel_lt_imp_lt [OF _ Oi CK])
have "|i|âMâ ⤠|succ(succ(x ⪠y))|âMâ ââMâ |succ(succ(x ⪠y))|âMâ" using IK xy
by (auto simp add: ieq types intro: InfCard_rel_is_Limit [THEN ordermap_csquare_le] types')
moreover have "|succ(succ(x ⪠y))|âMâ ââMâ |succ(succ(x ⪠y))|âMâ < K"
proof (cases rule: Ord_linear2 [OF ou Ord_nat])
assume "x ⪠y < nat"
hence "|succ(succ(x ⪠y))|âMâ ââMâ |succ(succ(x ⪠y))|âMâ â nat"
by (simp add: lt_def nat_cmult_rel_eq_mult nat_succI
nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq] types')
also have "... â K" using IK
by (simp add: InfCard_rel_def le_imp_subset types)
finally show "|succ(succ(x ⪠y))|âMâ ââMâ |succ(succ(x ⪠y))|âMâ < K"
by (simp add: ltI OK)
next
assume natxy: "nat ⤠x ⪠y"
hence seq: "|succ(succ(x ⪠y))|âMâ = |x ⪠y|âMâ" using xy
by (simp add: le_imp_subset nat_succ_eqpoll_rel [THEN cardinal_rel_cong] le_succ_iff types')
also have "... < K" using xy
by (simp add: Un_least_lt Ord_cardinal_rel_le [THEN lt_trans1] types')
finally have "|succ(succ(x ⪠y))|âMâ < K" .
moreover have "InfCardâMâ(|succ(succ(x ⪠y))|âMâ)" using xy natxy
by (simp add: seq InfCard_rel_def nat_le_cardinal_rel types')
ultimately show ?thesis by (simp add: eq ltD types')
qed
ultimately show "|i|âMâ < K" by (blast intro: lt_trans1)
qed (simp_all add:types')
qed
qed
lemma InfCard_rel_csquare_eq:
assumes IK: "InfCardâMâ(K)" and
types: "M(K)"
shows "K ââMâ K = K"
proof -
have OK: "Ord(K)" using IK by (simp add: Card_rel_is_Ord InfCard_rel_is_Card_rel types)
from OK assms
show "K ââMâ K = K"
proof (induct rule: trans_induct)
case (step i)
note types = â¹M(K)⺠â¹M(i)âº
show "i ââMâ i = i"
proof (rule le_anti_sym)
from step types
have Mot:"M(ordertype(i à i, csquare_rel(i)))" "M(ordermap(i à i, csquare_rel(i)))"
using well_ord_csquare Limit_is_Ord by simp_all
then
have "|i à i|âMâ = |ordertype(i à i, csquare_rel(i))|âMâ"
by (rule_tac cardinal_rel_cong,
simp_all add: step.hyps well_ord_csquare [THEN ordermap_bij, THEN bij_imp_eqpoll_rel] types)
with Mot
have "i ââMâ i ⤠ordertype(i à i, csquare_rel(i))"
by (simp add: step.hyps cmult_rel_def Ord_cardinal_rel_le well_ord_csquare [THEN Ord_ordertype] types)
moreover
have "ordertype(i à i, csquare_rel(i)) ⤠i" using step
by (rule_tac ordertype_csquare_le_M) (simp add: types)
ultimately show "i ââMâ i ⤠i" by (rule le_trans)
next
show "i ⤠i ââMâ i" using step
by (blast intro: cmult_rel_square_le InfCard_rel_is_Card_rel)
qed
qed
qed
lemma well_ord_InfCard_rel_square_eq:
assumes r: "well_ord(A,r)" and I: "InfCardâMâ(|A|âMâ)" and
types: "M(A)" "M(r)"
shows "A Ã A ââMâ A"
proof -
have "A Ã A ââMâ |A|âMâ Ã |A|âMâ"
by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym r types)
also have "... ââMâ A"
proof (rule well_ord_cardinal_rel_eqE [OF _ r])
show "well_ord(|A|âMâ Ã |A|âMâ, rmult(|A|âMâ, Memrel(|A|âMâ), |A|âMâ, Memrel(|A|âMâ)))"
by (blast intro: well_ord_rmult well_ord_Memrel r types)
next
show "||A|âMâ Ã |A|âMâ|âMâ = |A|âMâ" using InfCard_rel_csquare_eq I
by (simp add: cmult_rel_def types)
qed (simp_all add:types)
finally show ?thesis by (simp_all add:types)
qed
lemma InfCard_rel_square_eqpoll:
assumes "InfCardâMâ(K)" and types:"M(K)" shows "K Ã K ââMâ K"
using assms
apply (rule_tac well_ord_InfCard_rel_square_eq)
apply (erule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN well_ord_Memrel])
apply (simp_all add: InfCard_rel_is_Card_rel [THEN Card_rel_cardinal_rel_eq] types)
done
lemma Inf_Card_rel_is_InfCard_rel: "[| CardâMâ(i); ~ Finite_rel(M,i) ; M(i) |] ==> InfCardâMâ(i)"
by (simp add: InfCard_rel_def Card_rel_is_Ord [THEN nat_le_infinite_Ord])
subsubsectionâ¹Toward's Kunen's Corollary 10.13 (1)âº
lemma InfCard_rel_le_cmult_rel_eq: "[| InfCardâMâ(K); L ⤠K; 0<L; M(K) ; M(L) |] ==> K ââMâ L = K"
apply (rule le_anti_sym)
prefer 2
apply (erule ltE, blast intro: cmult_rel_le_self InfCard_rel_is_Card_rel)
apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
apply (rule cmult_rel_le_mono [THEN le_trans], assumption+)
apply (simp_all add: InfCard_rel_csquare_eq)
done
lemma InfCard_rel_cmult_rel_eq: "[| InfCardâMâ(K); InfCardâMâ(L); M(K) ; M(L) |] ==> K ââMâ L = K ⪠L"
apply (rule_tac i = K and j = L in Ord_linear_le)
apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
apply (rule cmult_rel_commute [THEN ssubst]) prefer 3
apply (rule Un_commute [THEN ssubst])
apply (simp_all add: InfCard_rel_is_Limit [THEN Limit_has_0] InfCard_rel_le_cmult_rel_eq
subset_Un_iff2 [THEN iffD1] le_imp_subset)
done
lemma InfCard_rel_cdouble_eq: "InfCardâMâ(K) â¹ M(K) â¹ K ââMâ K = K"
apply (simp add: cmult_rel_2 [symmetric] InfCard_rel_is_Card_rel cmult_rel_commute)
apply (simp add: InfCard_rel_le_cmult_rel_eq InfCard_rel_is_Limit Limit_has_0 Limit_has_succ)
done
lemma InfCard_rel_le_cadd_rel_eq: "[| InfCardâMâ(K); L ⤠K ; M(K) ; M(L)|] ==> K ââMâ L = K"
apply (rule le_anti_sym)
prefer 2
apply (erule ltE, blast intro: cadd_rel_le_self InfCard_rel_is_Card_rel)
apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
apply (rule cadd_rel_le_mono [THEN le_trans], assumption+)
apply (simp_all add: InfCard_rel_cdouble_eq)
done
lemma InfCard_rel_cadd_rel_eq: "[| InfCardâMâ(K); InfCardâMâ(L); M(K) ; M(L) |] ==> K ââMâ L = K ⪠L"
apply (rule_tac i = K and j = L in Ord_linear_le)
apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
apply (rule cadd_rel_commute [THEN ssubst]) prefer 3
apply (rule Un_commute [THEN ssubst])
apply (simp_all add: InfCard_rel_le_cadd_rel_eq subset_Un_iff2 [THEN iffD1] le_imp_subset)
done
end
subsectionâ¹For Every Cardinal Number There Exists A Greater Oneâº
textâ¹This result is Kunen's Theorem 10.16, which would be trivial using ACâº
locale M_cardinal_arith_jump = M_cardinal_arith + M_ordertype
begin
lemma well_ord_restr: "well_ord(X, r) â¹ well_ord(X, r â© XÃX)"
proof -
have "r â© XÃX â© XÃX = r â© XÃX" by auto
moreover
assume "well_ord(X, r)"
ultimately
show ?thesis
unfolding well_ord_def tot_ord_def part_ord_def linear_def
irrefl_def wf_on_def
by simp_all (simp only: trans_on_def, blast)
qed
lemma ordertype_restr_eq :
assumes "well_ord(X,r)"
shows "ordertype(X, r) = ordertype(X, r â© XÃX)"
using ordermap_restr_eq assms unfolding ordertype_def
by simp
lemma def_jump_cardinal_rel_aux:
"X â PowâMâ(K) â¹ well_ord(X, w) â¹ M(K) â¹
{z . r â PowâMâ(X à X), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)} =
{z . r â PowâMâ(K à K), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)}"
proof(rule,auto simp:Pow_rel_char dest:transM)
let ?L="{z . r â PowâMâ(X à X), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)}"
let ?R="{z . r â PowâMâ(K à K), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)}"
show "ordertype(X, r) â {y . x â {x â Pow(X à X) . M(x)}, M(y) ⧠well_ord(X, x) ⧠y = ordertype(X, x)}"
if "M(K)" "M(r)" "râKÃK" "XâK" "M(X)" "well_ord(X,r)" for r
proof -
from that
have "ordertype(X,r) = ordertype(X,râ©XÃX)" "(râ©XÃX)âXÃX" "M(râ©XÃX)"
"well_ord(X,râ©XÃX)" "wellordered(M,X,râ©XÃX)"
using well_ord_restr ordertype_restr_eq by auto
moreover from this
have "ordertype(X,râ©XÃX) â ?L"
using that Pow_rel_char
ReplaceI[of "λ z r . M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)" "ordertype(X,râ©XÃX)"]
by auto
ultimately
show ?thesis using Pow_rel_char by auto
qed
qed
lemma def_jump_cardinal_rel:
assumes "M(K)"
shows "jump_cardinal'_rel(M,K) =
(âXâPow_rel(M,K). {z. r â Pow_rel(M,K*K), well_ord(X,r) & z = ordertype(X,r)})"
proof -
have "M({z . r â PowâMâ(X à X), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)})"
(is "M(Replace(_,?P))")
if "M(X)" for X
using that jump_cardinal_closed_aux1[of X] ordertype_rel_abs[of X]
jump_cardinal_body_def
by (subst Replace_cong[where P="?P"
and Q="λr z. M(z) ⧠M(r) ⧠well_ord(X, r) ⧠z = ordertype_rel(M,X,r)",
OF refl, of "PowâMâ(X Ã X)"]) (auto dest:transM)
then
have "M({z . r â PowâMâ(Y à Y), M(z) ⧠well_ord(X, r) ⧠z = ordertype(X, r)})"
if "M(Y)" "M(X)" "X â PowâMâ(Y)" "well_ord(X,r)" for Y X r
using that def_jump_cardinal_rel_aux[of X Y r, symmetric] by simp
moreover from â¹M(K)âº
have "R â PowâMâ(X Ã X) â¹ X â PowâMâ(K) â¹ R â PowâMâ(K Ã K)"
for X R using mem_Pow_rel_abs transM[OF _ Pow_rel_closed, of R "XÃX"]
transM[OF _ Pow_rel_closed, of X K] by auto
ultimately
show ?thesis
using assms is_ordertype_iff is_well_ord_iff_wellordered
ordertype_rel_abs transM[of _ "PowâMâ(K)"] transM[of _ "PowâMâ(KÃK)"]
def_jump_cardinal_rel_aux
unfolding jump_cardinal'_rel_def
apply (intro equalityI)
apply (auto dest:transM)
apply (rename_tac X R)
apply (rule_tac x=X in bexI)
apply (rule_tac x=R in ReplaceI)
apply auto
apply (rule_tac x="{y . xa â PowâMâ(K à K), M(y) ⧠M(xa) ⧠well_ord(X, xa) ⧠y = ordertype(X, xa)}" in bexI)
apply auto
by (rule_tac x=X in ReplaceI) auto
qed
notation jump_cardinal'_rel (â¹jump'_cardinal'_relâº)
lemma Ord_jump_cardinal_rel: "M(K) â¹ Ord(jump_cardinal_rel(M,K))"
apply (unfold def_jump_cardinal_rel)
apply (rule Ord_is_Transset [THEN [2] OrdI])
prefer 2 apply (blast intro!: Ord_ordertype)
apply (unfold Transset_def)
apply (safe del: subsetI)
apply (subst ordertype_pred_unfold, simp, safe)
apply (rule UN_I)
apply (rule_tac [2] ReplaceI)
prefer 4 apply (blast intro: well_ord_subset elim!: predE, simp_all)
prefer 2 apply (blast intro: well_ord_subset elim!: predE)
proof -
fix X r xb
assume "M(K)" "X â PowâMâ(K)" "r â PowâMâ(K Ã K)" "well_ord(X, r)" "xb â X"
moreover from this
have "M(X)" "M(r)"
using cartprod_closed trans_Pow_rel_closed by auto
moreover from this
have "M(xb)" using transM[OF â¹xbâXâº] by simp
ultimately
show "Order.pred(X, xb, r) â PowâMâ(K)"
using def_Pow_rel by (auto dest:predE)
qed
declare conj_cong [cong del]
lemma jump_cardinal_rel_iff_old:
"M(i) â¹ M(K) â¹ i â jump_cardinal_rel(M,K) â·
(âr[M]. âX[M]. r â K*K & X â K & well_ord(X,r) & i = ordertype(X,r))"
apply (unfold def_jump_cardinal_rel)
apply (auto del: subsetI)
apply (rename_tac y r)
apply (rule_tac x=r in rexI, intro conjI) prefer 2
apply (rule_tac x=y in rexI, intro conjI)
apply (auto dest:mem_Pow_rel transM)
apply (rule_tac A=r in rev_subsetD, assumption)
defer
apply (rename_tac r y)
apply (rule_tac x=y in bexI)
apply (rule_tac x=r in ReplaceI, auto)
using def_Pow_rel
apply (force+)[2]
apply (rule_tac A=r in rev_subsetD, assumption)
using mem_Pow_rel[THEN conjunct1]
apply auto
done
lemma K_lt_jump_cardinal_rel: "Ord(K) ==> M(K) â¹ K < jump_cardinal_rel(M,K)"
apply (rule Ord_jump_cardinal_rel [THEN [2] ltI])
apply (rule jump_cardinal_rel_iff_old [THEN iffD2], assumption+)
apply (rule_tac x="Memrel(K)" in rexI)
apply (rule_tac x=K in rexI)
apply (simp add: ordertype_Memrel well_ord_Memrel)
using Memrel_closed
apply (simp_all add: Memrel_def subset_iff)
done
lemma Card_rel_jump_cardinal_rel_lemma:
"[| well_ord(X,r); r â K * K; X â K;
f â bij(ordertype(X,r), jump_cardinal_rel(M,K));
M(X); M(r); M(K); M(f) |]
==> jump_cardinal_rel(M,K) â jump_cardinal_rel(M,K)"
apply (subgoal_tac "f O ordermap (X,r) â bij (X, jump_cardinal_rel (M,K))")
prefer 2 apply (blast intro: comp_bij ordermap_bij)
apply (rule jump_cardinal_rel_iff_old [THEN iffD2], simp+)
apply (intro rexI conjI)
apply (rule subset_trans [OF rvimage_type Sigma_mono], assumption+)
apply (erule bij_is_inj [THEN well_ord_rvimage])
apply (rule Ord_jump_cardinal_rel [THEN well_ord_Memrel])
apply (simp_all add: well_ord_Memrel [THEN [2] bij_ordertype_vimage]
ordertype_Memrel Ord_jump_cardinal_rel)
done
lemma Card_rel_jump_cardinal_rel: "M(K) â¹ Card_rel(M,jump_cardinal_rel(M,K))"
apply (rule Ord_jump_cardinal_rel [THEN Card_relI])
apply (simp_all add: def_eqpoll_rel)
apply (drule_tac i1=j in jump_cardinal_rel_iff_old [THEN iffD1, OF _ _ ltD, of _ K], safe)
apply (blast intro: Card_rel_jump_cardinal_rel_lemma [THEN mem_irrefl])
done
subsectionâ¹Basic Properties of Successor Cardinalsâº
lemma csucc_rel_basic: "Ord(K) ==> M(K) â¹ Card_rel(M,csucc_rel(M,K)) & K < csucc_rel(M,K)"
apply (unfold csucc_rel_def)
apply (rule LeastI[of "λi. M(i) ⧠Card_rel(M,i) ⧠K < i", THEN conjunct2])
apply (blast intro: Card_rel_jump_cardinal_rel K_lt_jump_cardinal_rel Ord_jump_cardinal_rel)+
done
lemmas Card_rel_csucc_rel = csucc_rel_basic [THEN conjunct1]
lemmas lt_csucc_rel = csucc_rel_basic [THEN conjunct2]
lemma Ord_0_lt_csucc_rel: "Ord(K) ==> M(K) â¹ 0 < csucc_rel(M,K)"
by (blast intro: Ord_0_le lt_csucc_rel lt_trans1)
lemma csucc_rel_le: "[| Card_rel(M,L); K<L; M(K); M(L) |] ==> csucc_rel(M,K) ⤠L"
apply (unfold csucc_rel_def)
apply (rule Least_le)
apply (blast intro: Card_rel_is_Ord)+
done
lemma lt_csucc_rel_iff: "[| Ord(i); Card_rel(M,K); M(K); M(i)|] ==> i < csucc_rel(M,K) â· |i|âMâ ⤠K"
apply (rule iffI)
apply (rule_tac [2] Card_rel_lt_imp_lt)
apply (erule_tac [2] lt_trans1)
apply (simp_all add: lt_csucc_rel Card_rel_csucc_rel Card_rel_is_Ord)
apply (rule notI [THEN not_lt_imp_le])
apply (rule Card_rel_cardinal_rel [THEN csucc_rel_le, THEN lt_trans1, THEN lt_irrefl], simp_all+)
apply (rule Ord_cardinal_rel_le [THEN lt_trans1])
apply (simp_all add: Card_rel_is_Ord)
done
lemma Card_rel_lt_csucc_rel_iff:
"[| Card_rel(M,K'); Card_rel(M,K); M(K'); M(K) |] ==> K' < csucc_rel(M,K) ⷠK' ⤠K"
by (simp add: lt_csucc_rel_iff Card_rel_cardinal_rel_eq Card_rel_is_Ord)
lemma InfCard_rel_csucc_rel: "InfCard_rel(M,K) â¹ M(K) ==> InfCard_rel(M,csucc_rel(M,K))"
by (simp add: InfCard_rel_def Card_rel_csucc_rel Card_rel_is_Ord
lt_csucc_rel [THEN leI, THEN [2] le_trans])
subsubsectionâ¹Theorems by Krzysztof Grabczewski, proofs by lcpâº
lemma nat_sum_eqpoll_rel_sum:
assumes m: "m â nat" and n: "n â nat" shows "m + n ââMâ m +â©Ï n"
proof -
have "m + n ââMâ |m+n|âMâ" using m n
by (blast intro: nat_implies_well_ord well_ord_radd well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
also have "... = m +â©Ï n" using m n
by (simp add: nat_cadd_rel_eq_add [symmetric] cadd_rel_def transM[OF _ M_nat])
finally show ?thesis .
qed
lemma Ord_nat_subset_into_Card_rel: "[| Ord(i); i â nat |] ==> CardâMâ(i)"
by (blast dest: Ord_subset_natD intro: Card_rel_nat nat_into_Card_rel)
end
end
body>
Theory Aleph_Relative
theory Aleph_Relative
imports
CardinalArith_Relative
begin
definition
HAleph :: "[i,i] â i" where
"HAleph(i,r) â¡ if(¬(Ord(i)),i,if(i=0, nat, if(¬Limit(i) ⧠iâ 0,
csucc(r`( â i )),
âjâi. r`j)))"
reldb_add functional "Limit" "Limit"
relationalize "Limit" "is_Limit" external
synthesize "is_Limit" from_definition
arity_theorem for "is_Limit_fm"
relativize functional "HAleph" "HAleph_rel"
relationalize "HAleph_rel" "is_HAleph"
synthesize "is_HAleph" from_definition assuming "nonempty"
arity_theorem intermediate for "is_HAleph_fm"
lemma arity_is_HAleph_fm_aux:
assumes
"i â nat" "r â nat"
shows
"arity(Replace_fm(8 +â©Ï i, â
10 +â©Ï r`0 is 1â
, 3)) = 9 +â©Ï i ⪠pred(pred(11 +â©Ï r))"
using arity_Replace_fm[of "â
(10+â©Ïr)`0 is 1â
" "8+â©Ïi" 3 "(11+â©Ïr) ⪠1 ⪠2"]
ord_simp_union
by (auto simp:arity)
lemma arity_is_HAleph_fm[arity]:
assumes
"i â nat" "r â nat" "l â nat"
shows
"arity(is_HAleph_fm(i, r, l)) = succ(i) ⪠succ(l) ⪠succ(r)"
using assms pred_Un arity_is_HAleph_fm_aux arity_is_HAleph_fm'
by auto
definition
Aleph' :: "i => i" where
"Aleph'(a) == transrec(a,λi r. HAleph(i,r))"
relativize functional "Aleph'" "Aleph_rel"
relationalize "Aleph_rel" "is_Aleph"
txtâ¹The extra assumptions \<^term>â¹a < length(env)⺠and \<^term>â¹c < length(env)âº
in this schematic goal (and the following results on synthesis that
depend on it) are imposed by @{thm is_transrec_iff_sats}.âº
schematic_goal sats_is_Aleph_fm_auto:
"a â nat â¹ c â nat â¹ env â list(A) â¹
a < length(env) â¹ c < length(env) â¹ 0 â A â¹
is_Aleph(##A, nth(a, env), nth(c, env)) ⷠA, env ⨠?fm(a, c)"
unfolding is_Aleph_def
proof (rule is_transrec_iff_sats, rule_tac [1] is_HAleph_iff_sats)
fix a0 a1 a2 a3 a4 a5 a6 a7
let ?env' = "Cons(a0, Cons(a1, Cons(a2, Cons(a3, Cons(a4, Cons(a5, Cons(a6, Cons(a7, env))))))))"
show "nth(2, ?env') = a2"
"nth(1, ?env') = a1"
"nth(0, ?env') = a0"
"nth(c, env) = nth(c, env)"
by simp_all
qed simp_all
synthesize_notc "is_Aleph" from_schematic
notation is_Aleph_fm (â¹â
âµ'(_') is _â
âº)
lemma is_Aleph_fm_type [TC]: "a â nat â¹ c â nat â¹ is_Aleph_fm(a, c) â formula"
unfolding is_Aleph_fm_def by simp
lemma sats_is_Aleph_fm:
assumes "fânat" "rânat" "env â list(A)" "0âA" "f < length(env)" "r< length(env)"
shows "is_Aleph(##A, nth(f, env), nth(r, env)) ⷠA, env ⨠is_Aleph_fm(f,r)"
using assms sats_is_Aleph_fm_auto unfolding is_Aleph_def is_Aleph_fm_def by simp
lemma is_Aleph_iff_sats [iff_sats]:
assumes
"nth(f, env) = fa" "nth(r, env) = ra" "f < length(env)" "r< length(env)"
"f â nat" "r â nat" "env â list(A)" "0âA"
shows "is_Aleph(##A,fa,ra) ⷠA, env ⨠is_Aleph_fm(f,r)"
using assms sats_is_Aleph_fm[of f r env A] by simp
arity_theorem for "is_Aleph_fm"
lemma (in M_cardinal_arith_jump) is_Limit_iff:
assumes "M(a)"
shows "is_Limit(M,a) â· Limit(a)"
unfolding is_Limit_def Limit_def using lt_abs transM[OF ltD â¹M(a)âº] assms
by auto
lemma HAleph_eq_Aleph_recursive:
"Ord(i) â¹ HAleph(i,r) = (if i = 0 then nat
else if âj. i = succ(j) then csucc(r ` (THE j. i = succ(j))) else âj<i. r ` j)"
proof -
assume "Ord(i)"
moreover from this
have "i = succ(j) â¹ (âsucc(j)) = j" for j
using Ord_Union_succ_eq by simp
moreover from â¹Ord(i)âº
have "(âj. i = succ(j)) ⷠ¬Limit(i) ⧠i â 0"
using Ord_cases_disj by auto
ultimately
show ?thesis
unfolding HAleph_def OUnion_def
by auto
qed
lemma Aleph'_eq_Aleph: "Ord(a) â¹ Aleph'(a) = Aleph(a)"
unfolding Aleph'_def Aleph_def transrec2_def
using HAleph_eq_Aleph_recursive
by (intro transrec_equal_on_Ord) auto
reldb_rem functional "Aleph'"
reldb_rem relational "is_Aleph"
reldb_add functional "Aleph" "Aleph_rel"
reldb_add relational "Aleph" "is_Aleph"
abbreviation
Aleph_r :: "[i,iâo] â i" (â¹âµâ_ââ_ââº) where
"Aleph_r(a,M) â¡ Aleph_rel(M,a)"
abbreviation
Aleph_r_set :: "[i,i] â i" (â¹âµâ_ââ_ââº) where
"Aleph_r_set(a,M) â¡ Aleph_rel(##M,a)"
lemma Aleph_rel_def': "Aleph_rel(M,a) ⡠transrec(a, λi r. HAleph_rel(M, i, r))"
unfolding Aleph_rel_def .
lemma succ_mem_Limit: "Limit(j) â¹ i â j â¹ succ(i) â j"
using Limit_has_succ[THEN ltD] ltI Limit_is_Ord by auto
locale M_pre_aleph = M_eclose + M_cardinal_arith_jump +
assumes
haleph_transrec_replacement: "M(a) â¹ transrec_replacement(M,is_HAleph(M),a)"
begin
lemma aux_ex_Replace_funapply:
assumes "M(a)" "M(f)"
shows "âx[M]. is_Replace(M, a, λj y. f ` j = y, x)"
proof -
have "{f`j . jâa} = {y . jâa , f ` j=y}"
"{y . jâa , f ` j=y} = {y . jâa , y =f ` j}"
by auto
moreover
note assms
moreover from calculation
have "x â a â¹ y = f `x â¹ M(y)" for x y
using transM[OF _ â¹M(a)âº] by auto
moreover from assms
have "M({f`j . jâa})"
using transM[OF _ â¹M(a)âº] RepFun_closed[OF apply_replacement] by simp
ultimately
have 2:"is_Replace(M, a, λj y. y = f ` j, {f`j . jâa})"
using Replace_abs[of _ _ "λj y. y = f ` j",OF â¹M(a)âº,THEN iffD2]
by auto
with â¹M({f`j . jâa})âº
show ?thesis
using
is_Replace_cong[of _ _ M "λj y. y = f ` j" "λj y. f ` j = y", THEN iffD1,OF _ _ _ 2]
by auto
qed
lemma is_HAleph_zero:
assumes "M(f)"
shows "is_HAleph(M,0,f,res) â· res = nat"
unfolding is_HAleph_def
using Ord_0 If_abs is_Limit_iff is_csucc_iff assms aux_ex_Replace_funapply
by auto
lemma is_HAleph_succ:
assumes "M(f)" "M(x)" "Ord(x)" "M(res)"
shows "is_HAleph(M,succ(x),f,res) â· res = csucc_rel(M,f`x)"
unfolding is_HAleph_def
using assms is_Limit_iff is_csucc_iff aux_ex_Replace_funapply If_abs Ord_Union_succ_eq
by simp
lemma is_HAleph_limit:
assumes "M(f)" "M(x)" "Limit(x)" "M(res)"
shows "is_HAleph(M,x,f,res) â· res = (â{y . iâx ,M(i) ⧠M(y) ⧠y = f`i})"
proof -
from assms
have "univalent(M, x, λj y. y = f ` j )"
"(âxa y. xa â x â¹ f ` xa = y â¹ M(y))"
"{y . x â x, f ` x = y} = {y . iâx ,M(i) ⧠M(y) ⧠y = f`i}"
using univalent_triv[of M x "λj .f ` j"] transM[OF _ â¹M(x)âº]
by auto
moreover
from this
have "univalent(M, x, λj y. f ` j = y )"
by (rule_tac univalent_cong[of x x M " λj y. y = f ` j" " λj y. f ` j=y",THEN iffD1], auto)
moreover
from this
have "univalent(M, x, λj y. M(j) ⧠M(y) ⧠f ` j = y )"
by auto
ultimately
show ?thesis
unfolding is_HAleph_def
using assms is_Limit_iff Limit_is_Ord zero_not_Limit If_abs is_csucc_iff
Replace_abs apply_replacement
by auto
qed
lemma is_HAleph_iff:
assumes "M(a)" "M(f)" "M(res)"
shows "is_HAleph(M, a, f, res) â· res = HAleph_rel(M, a, f)"
proof(cases "Ord(a)")
case True
note Ord_cases[OF â¹Ord(a)âº]
then
show ?thesis
proof(cases )
case 1
with True assms
show ?thesis
using is_HAleph_zero unfolding HAleph_rel_def
by simp
next
case (2 j)
with True assms
show ?thesis
using is_HAleph_succ Ord_Union_succ_eq
unfolding HAleph_rel_def
by simp
next
case 3
with assms
show ?thesis
using is_HAleph_limit zero_not_Limit Limit_is_Ord
unfolding HAleph_rel_def
by auto
qed
next
case False
then
have "¬Limit(a)" "aâ 0" "â x . Ord(x) â¹ aâ succ(x)"
using Limit_is_Ord by auto
with False
show ?thesis
unfolding is_HAleph_def HAleph_rel_def
using assms is_Limit_iff If_abs is_csucc_iff aux_ex_Replace_funapply
by auto
qed
lemma HAleph_rel_closed [intro,simp]:
assumes "function(f)" "M(a)" "M(f)"
shows "M(HAleph_rel(M,a,f))"
unfolding HAleph_rel_def
using assms apply_replacement
by simp
lemma Aleph_rel_closed[intro, simp]:
assumes "Ord(a)" "M(a)"
shows "M(Aleph_rel(M,a))"
proof -
have "relation2(M, is_HAleph(M), HAleph_rel(M))"
unfolding relation2_def using is_HAleph_iff assms by simp
moreover
have "âx[M]. âg[M]. function(g) ⶠM(HAleph_rel(M, x, g))"
using HAleph_rel_closed by simp
moreover
note assms
ultimately
show ?thesis
unfolding Aleph_rel_def
using transrec_closed[of "is_HAleph(M)" a "HAleph_rel(M)"]
haleph_transrec_replacement by simp
qed
lemma Aleph_rel_zero: "âµâ0ââMâ = nat"
using def_transrec [OF Aleph_rel_def',of _ 0]
unfolding HAleph_rel_def by simp
lemma Aleph_rel_succ: "Ord(α) â¹ M(α) â¹ âµâsucc(α)ââMâ = (âµâαââMââ§+)âMâ"
using Ord_Union_succ_eq
by (subst def_transrec [OF Aleph_rel_def'])
(simp add:HAleph_rel_def)
lemma Aleph_rel_limit:
assumes "Limit(α)" "M(α)"
shows "âµâαââMâ = â{âµâjââMâ . j â α}"
proof -
note trans=transM[OF _ â¹M(α)âº]
from â¹M(α)âº
have "âµâαââMâ = HAleph_rel(M, α, λxâα. âµâxââMâ)"
using def_transrec [OF Aleph_rel_def',of M α] by simp
also
have "... = â{a . j â α, M(a) ⧠a = âµâjââMâ}"
unfolding HAleph_rel_def
using assms zero_not_Limit Limit_is_Ord trans by auto
also
have "... = â{âµâjââMâ . j â α}"
using Aleph_rel_closed[OF _ trans] Ord_in_Ord Limit_is_Ord[OF â¹Limit(α)âº] by auto
finally
show ?thesis .
qed
lemma is_Aleph_iff:
assumes "Ord(a)" "M(a)" "M(res)"
shows "is_Aleph(M, a, res) â· res = âµâaââMâ"
proof -
have "relation2(M, is_HAleph(M), HAleph_rel(M))"
unfolding relation2_def using is_HAleph_iff assms by simp
moreover
have "âx[M]. âg[M]. function(g) ⶠM(HAleph_rel(M, x, g))"
using HAleph_rel_closed by simp
ultimately
show ?thesis
using assms transrec_abs haleph_transrec_replacement
unfolding is_Aleph_def Aleph_rel_def
by simp
qed
end
locale M_aleph = M_pre_aleph +
assumes
aleph_rel_replacement: "strong_replacement(M, λx y. Ord(x) ⧠y = âµâxââMâ)"
begin
lemma Aleph_rel_cont: "Limit(l) â¹ M(l) â¹ âµâlââMâ = (âi<l. âµâiââMâ)"
using Limit_is_Ord Aleph_rel_limit
by (simp add:OUnion_def)
lemma Ord_Aleph_rel:
assumes "Ord(a)"
shows "M(a) â¹ Ord(âµâaââMâ)"
using â¹Ord(a)âº
proof(induct a rule:trans_induct3)
case 0
show ?case using Aleph_rel_zero by simp
next
case (succ x)
with â¹Ord(x)âº
have "M(x)" "Ord(âµâxââMâ)" by simp_all
with â¹Ord(x)âº
have "Ord(csucc_rel(M,âµâxââMâ))"
using Card_rel_is_Ord Card_rel_csucc_rel
by simp
with â¹Ord(x)⺠â¹M(x)âº
show ?case using Aleph_rel_succ by simp
next
case (limit x)
note trans=transM[OF _ â¹M(x)âº]
from limit
have "âµâxââMâ = (âiâx. âµâiââMâ)"
using Aleph_rel_cont OUnion_def Limit_is_Ord
by auto
with limit
show ?case using Ord_UN trans by auto
qed
lemma Card_rel_Aleph_rel [simp, intro]:
assumes "Ord(a)" and types: "M(a)" shows "CardâMâ(âµâaââMâ)"
using assms
proof (induct rule:trans_induct3)
case 0
then
show ?case
using Aleph_rel_zero Card_rel_nat by simp
next
case (succ x)
then
show ?case
using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ
by simp
next
case (limit x)
moreover
from this
have "M({y . z â x, M(y) ⧠M(z) ⧠Ord(z) ⧠y = âµâzââMâ})"
using aleph_rel_replacement
by auto
moreover
have "{y . z â x, M(y) ⧠M(z) ⧠y = âµâzââMâ} = {y . z â x, M(y) ⧠M(z) ⧠Ord(z) ⧠y = âµâzââMâ}"
using Ord_in_Ord Limit_is_Ord[OF limit(1)] by simp
ultimately
show ?case
using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI
by (subst def_transrec [OF Aleph_rel_def'])
(auto simp add:HAleph_rel_def)
qed
lemma Aleph_rel_increasing:
assumes "a < b" and types: "M(a)" "M(b)"
shows "âµâaââMâ < âµâbââMâ"
proof -
{ fix x
from assms
have "Ord(b)"
by (blast intro: lt_Ord2)
moreover
assume "M(x)"
moreover
note â¹M(b)âº
ultimately
have "x < b â¹ âµâxââMâ < âµâbââMâ"
proof (induct b arbitrary: x rule: trans_induct3)
case 0 thus ?case by simp
next
case (succ b)
then
show ?case
using Card_rel_csucc_rel Ord_Aleph_rel Ord_Union_succ_eq lt_csucc_rel
lt_trans[of _ "âµâbââMâ" "csuccâMâ(âµâbââMâ)"]
by (subst (2) def_transrec[OF Aleph_rel_def'])
(auto simp add: le_iff HAleph_rel_def)
next
case (limit l)
then
have sc: "succ(x) < l"
by (blast intro: Limit_has_succ)
then
have "âµâxââMâ < (âj<l. âµâjââMâ)"
using limit Ord_Aleph_rel Ord_OUN
proof(rule_tac OUN_upper_lt,blast intro: Card_rel_is_Ord ltD lt_Ord)
from â¹x<l⺠â¹Limit(l)âº
have "Ord(x)"
using Limit_is_Ord Ord_in_Ord
by (auto dest!:ltD)
with â¹M(x)âº
show "âµâxââMâ < âµâsucc(x)ââMâ"
using Card_rel_csucc_rel Ord_Aleph_rel lt_csucc_rel
ltD[THEN [2] Ord_in_Ord] succ_in_MI[OF â¹M(x)âº]
Aleph_rel_succ[of x]
by (simp)
next
from â¹M(l)⺠â¹Limit(l)âº
show "Ord(âj<l. âµâjââMâ)"
using Ord_Aleph_rel lt_Ord Limit_is_Ord Ord_in_Ord
by (rule_tac Ord_OUN)
(auto dest:transM ltD intro!:Ord_Aleph_rel)
qed
then
show ?case using limit Aleph_rel_cont by simp
qed
}
with types assms
show ?thesis by simp
qed
lemmas nat_subset_Aleph_rel_1 =
Ord_lt_subset[OF Ord_Aleph_rel[of 1] Aleph_rel_increasing[of 0 1,simplified],simplified]
end
endd>
Theory Cardinal_AC_Relative
sectionâ¹Relative, Cardinal Arithmetic Using ACâº
theory Cardinal_AC_Relative
imports
CardinalArith_Relative
begin
locale M_AC =
fixes M
assumes
choice_ax: "choice_ax(M)"
locale M_cardinal_AC = M_cardinal_arith + M_AC
begin
lemma well_ord_surj_imp_lepoll_rel:
assumes "well_ord(A,r)" "h â surj(A,B)" and
types:"M(A)" "M(r)" "M(h)" "M(B)"
shows "B â²âMâ A"
proof -
note eq=vimage_fun_sing[OF surj_is_fun[OF â¹hâ_âº]]
from assms
have "(λbâB. minimum(r, {aâA. h`a=b})) â inj(B,A)" (is "?fâ_")
using well_ord_surj_imp_inj_inverse assms(1,2) by simp
with assms
have "M(?f`b)" if "bâB" for b
using apply_type[OF inj_is_fun[OF â¹?fâ_âº]] that transM[OF _ â¹M(A)âº] by simp
with assms
have "M(?f)"
using lam_closed surj_imp_inj_replacement4 eq by auto
with â¹?fâ_⺠assms
have "?f â injâMâ(B,A)"
using mem_inj_abs by simp
with â¹M(?f)âº
show ?thesis unfolding lepoll_rel_def by auto
qed
lemma surj_imp_well_ord_M:
assumes wos: "well_ord(A,r)" "h â surj(A,B)"
and
types: "M(A)" "M(r)" "M(h)" "M(B)"
shows "âs[M]. well_ord(B,s)"
using assms lepoll_rel_well_ord
well_ord_surj_imp_lepoll_rel by fast
lemma choice_ax_well_ord: "M(S) â¹ âr[M]. well_ord(S,r)"
using choice_ax well_ord_Memrel[THEN surj_imp_well_ord_M]
unfolding choice_ax_def by auto
lemma Finite_cardinal_rel_Finite:
assumes "Finite(|i|âMâ)" "M(i)"
shows "Finite(i)"
proof -
note assms
moreover from this
obtain r where "M(r)" "well_ord(i,r)"
using choice_ax_well_ord by auto
moreover from calculation
have "|i|âMâ ââMâ i"
using well_ord_cardinal_rel_eqpoll_rel
by auto
ultimately
show ?thesis
using eqpoll_rel_imp_Finite
by auto
qed
end
locale M_Pi_assumptions_choice = M_Pi_assumptions + M_cardinal_AC +
assumes
B_replacement: "strong_replacement(M, λx y. y = B(x))"
and
minimum_replacement: "M(r) â¹ strong_replacement(M, λx y. y = â¨x, minimum(r, B(x))â©)"
begin
lemma AC_M:
assumes "a â A" "âx. x â A â¹ ây. y â B(x)"
shows "âz[M]. z â PiâMâ(A, B)"
proof -
have "M(âxâA. B(x))" using assms family_union_closed Pi_assumptions B_replacement by simp
then
obtain r where "well_ord(âxâA. B(x),r)" "M(r)"
using choice_ax_well_ord by blast
let ?f="λxâA. minimum(r,B(x))"
have "M(minimum(r, B(x)))" if "xâA" for x
proof -
from â¹well_ord(_,r)⺠â¹xâAâº
have "well_ord(B(x),r)" using well_ord_subset UN_upper by simp
with assms â¹xâA⺠â¹M(r)âº
show ?thesis using Pi_assumptions by blast
qed
with assms and â¹M(r)âº
have "M(?f)"
using Pi_assumptions minimum_replacement lam_closed
by simp
moreover from assms and calculation
have "?f â PiâMâ(A,B)"
using lam_type[OF minimum_in, OF â¹well_ord(âxâA. B(x),r)âº, of A B]
Pi_rel_char by auto
ultimately
show ?thesis by blast
qed
lemma AC_Pi_rel: assumes "âx. x â A â¹ ây. y â B(x)"
shows "âz[M]. z â PiâMâ(A, B)"
proof (cases "A=0")
interpret Pi0:M_Pi_assumptions_0
using Pi_assumptions by unfold_locales auto
case True
then
show ?thesis using assms by simp
next
case False
then
obtain a where "a â A" by auto
with assms
show ?thesis by (blast intro!: AC_M)
qed
end
context M_cardinal_AC
begin
subsectionâ¹Strengthened Forms of Existing Theorems on Cardinalsâº
lemma cardinal_rel_eqpoll_rel: "M(A) â¹ |A|âMâ ââMâ A"
apply (rule choice_ax_well_ord [THEN rexE])
apply (auto intro:well_ord_cardinal_rel_eqpoll_rel)
done
lemmas cardinal_rel_idem = cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong, simp]
lemma cardinal_rel_eqE: "|X|âMâ = |Y|âMâ ==> M(X) â¹ M(Y) â¹ X ââMâ Y"
apply (rule choice_ax_well_ord [THEN rexE], assumption)
apply (rule choice_ax_well_ord [THEN rexE, of Y], assumption)
apply (rule well_ord_cardinal_rel_eqE, assumption+)
done
lemma cardinal_rel_eqpoll_rel_iff: "M(X) â¹ M(Y) â¹ |X|âMâ = |Y|âMâ â· X ââMâ Y"
by (blast intro: cardinal_rel_cong cardinal_rel_eqE)
lemma cardinal_rel_disjoint_Un:
"[| |A|âMâ=|B|âMâ; |C|âMâ=|D|âMâ; A â© C = 0; B â© D = 0; M(A); M(B); M(C); M(D)|]
==> |A ⪠C|âMâ = |B ⪠D|âMâ"
by (simp add: cardinal_rel_eqpoll_rel_iff eqpoll_rel_disjoint_Un)
lemma lepoll_rel_imp_cardinal_rel_le: "A â²âMâ B ==> M(A) â¹ M(B) â¹ |A|âMâ ⤠|B|âMâ"
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (erule well_ord_lepoll_rel_imp_cardinal_rel_le, assumption+)
done
lemma cadd_rel_assoc: "â¦M(i); M(j); M(k)⧠⹠(i ââMâ j) ââMâ k = i ââMâ (j ââMâ k)"
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule well_ord_cadd_rel_assoc, assumption+)
done
lemma cmult_rel_assoc: "â¦M(i); M(j); M(k)⧠⹠(i ââMâ j) ââMâ k = i ââMâ (j ââMâ k)"
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule well_ord_cmult_rel_assoc, assumption+)
done
lemma cadd_cmult_distrib: "â¦M(i); M(j); M(k)⧠⹠(i ââMâ j) ââMâ k = (i ââMâ k) ââMâ (j ââMâ k)"
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (rule well_ord_cadd_cmult_distrib, assumption+)
done
lemma InfCard_rel_square_eq: "InfCardâMâ(|A|âMâ) â¹ M(A) â¹ AÃA ââMâ A"
apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
apply (erule well_ord_InfCard_rel_square_eq, assumption, simp_all)
done
subsection â¹The relationship between cardinality and le-pollenceâº
lemma Card_rel_le_imp_lepoll_rel:
assumes "|A|âMâ ⤠|B|âMâ"
and types: "M(A)" "M(B)"
shows "A â²âMâ B"
proof -
have "A ââMâ |A|âMâ"
by (rule cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym], simp_all add:types)
also have "... â²âMâ |B|âMâ"
by (rule le_imp_subset [THEN subset_imp_lepoll_rel]) (rule assms, simp_all add:types)
also have "... ââMâ B"
by (rule cardinal_rel_eqpoll_rel, simp_all add:types)
finally show ?thesis by (simp_all add:types)
qed
lemma le_Card_rel_iff: "CardâMâ(K) ==> M(K) â¹ M(A) â¹ |A|âMâ ⤠K â· A â²âMâ K"
apply (erule Card_rel_cardinal_rel_eq [THEN subst], assumption, rule iffI,
erule Card_rel_le_imp_lepoll_rel, assumption+)
apply (erule lepoll_rel_imp_cardinal_rel_le, assumption+)
done
lemma cardinal_rel_0_iff_0 [simp]: "M(A) â¹ |A|âMâ = 0 â· A = 0"
using cardinal_rel_0 eqpoll_rel_0_iff [THEN iffD1]
cardinal_rel_eqpoll_rel_iff [THEN iffD1, OF _ nonempty]
by auto
lemma cardinal_rel_lt_iff_lesspoll_rel:
assumes i: "Ord(i)" and
types: "M(i)" "M(A)"
shows "i < |A|âMâ â· i âºâMâ A"
proof
assume "i < |A|âMâ"
hence "i âºâMâ |A|âMâ"
by (blast intro: lt_Card_rel_imp_lesspoll_rel types)
also have "... ââMâ A"
by (rule cardinal_rel_eqpoll_rel) (simp_all add:types)
finally show "i âºâMâ A" by (simp_all add:types)
next
assume "i âºâMâ A"
also have "... ââMâ |A|âMâ"
by (blast intro: cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
finally have "i âºâMâ |A|âMâ" by (simp_all add:types)
thus "i < |A|âMâ" using i types
by (force intro: cardinal_rel_lt_imp_lt lesspoll_rel_cardinal_rel_lt)
qed
lemma cardinal_rel_le_imp_lepoll_rel: " i ⤠|A|âMâ ==> M(i) â¹ M(A) â¹i â²âMâ A"
by (blast intro: lt_Ord Card_rel_le_imp_lepoll_rel Ord_cardinal_rel_le le_trans)
subsectionâ¹Other Applications of ACâº
textâ¹We have an example of instantiating a locale involving higher
order variables inside a proof, by using the assumptions of the
first order, active locale.âº
lemma surj_rel_implies_inj_rel:
assumes f: "f â surjâMâ(X,Y)" and
types: "M(f)" "M(X)" "M(Y)"
shows "âg[M]. g â injâMâ(Y,X)"
proof -
from types
interpret M_Pi_assumptions_choice _ Y "λy. f-``{y}"
by unfold_locales (auto intro:surj_imp_inj_replacement dest:transM)
from f AC_Pi_rel
obtain z where z: "z â PiâMâ(Y, λy. f -`` {y})"
using surj_rel_char
by (auto simp add: surj_def types) (fast dest: apply_Pair)
show ?thesis
proof
show "z â injâMâ(Y, X)" "M(z)"
using z surj_is_fun[of f X Y] f Pi_rel_char
by (auto dest: apply_type Pi_memberD
intro: apply_equality Pi_type f_imp_injective
simp add:types mem_surj_abs)
qed
qed
textâ¹Kunen's Lemma 10.20âº
lemma surj_rel_implies_cardinal_rel_le:
assumes f: "f â surjâMâ(X,Y)" and
types:"M(f)" "M(X)" "M(Y)"
shows "|Y|âMâ ⤠|X|âMâ"
proof (rule lepoll_rel_imp_cardinal_rel_le)
from f [THEN surj_rel_implies_inj_rel]
obtain g where "g â injâMâ(Y,X)"
by (blast intro:types)
then
show "Y â²âMâ X"
using inj_rel_char
by (auto simp add: def_lepoll_rel types)
qed (simp_all add:types)
end
textâ¹The set-theoretic universe.âº
abbreviation
Universe :: "iâo" (â¹ð±âº) where
"ð±(x) â¡ True"
lemma separation_absolute: "separation(ð±, P)"
unfolding separation_def
by (rule rallI, rule_tac x="{xâ_ . P(x)}" in rexI) auto
lemma univalent_absolute:
assumes "univalent(ð±, A, P)" "P(x, b)" "x â A"
shows "P(x, y) â¹ y = b"
using assms
unfolding univalent_def by force
lemma replacement_absolute: "strong_replacement(ð±, P)"
unfolding strong_replacement_def
proof (intro rallI impI)
fix A
assume "univalent(ð±, A, P)"
then
show "âY[ð±]. âb[ð±]. b â Y â· (âx[ð±]. x â A ⧠P(x, b))"
by (rule_tac x="{y. xâA , P(x,y)}" in rexI)
(auto dest:univalent_absolute[of _ P])
qed
lemma Union_ax_absolute: "Union_ax(ð±)"
unfolding Union_ax_def big_union_def
by (auto intro:rexI[of _ "â_"])
lemma upair_ax_absolute: "upair_ax(ð±)"
unfolding upair_ax_def upair_def rall_def rex_def
by (auto)
lemma power_ax_absolute:"power_ax(ð±)"
proof -
{
fix x
have "ây[ð±]. y â Pow(x) â· (âz[ð±]. z â y ⶠz â x)"
by auto
}
then
show "power_ax(ð±)"
unfolding power_ax_def powerset_def subset_def by blast
qed
locale M_cardinal_UN = M_Pi_assumptions_choice _ K X for K X +
assumes
X_witness_in_M: "w â X(x) â¹ M(x)"
and
lam_m_replacement:"M(f) â¹ strong_replacement(M,
λx y. y = â¨x, μ i. x â X(i), f ` (μ i. x â X(i)) ` xâ©)"
and
inj_replacement:
"M(x) â¹ strong_replacement(M, λy z. y â injâMâ(X(x), K) ⧠z = {â¨x, yâ©})"
"strong_replacement(M, λx y. y = injâMâ(X(x), K))"
"strong_replacement(M,
λx z. z = Sigfun(x, λi. injâMâ(X(i), K)))"
"M(r) â¹ strong_replacement(M,
λx y. y = â¨x, minimum(r, injâMâ(X(x), K))â©)"
begin
lemma UN_closed: "M(âiâK. X(i))"
using family_union_closed B_replacement Pi_assumptions by simp
textâ¹Kunen's Lemma 10.21âº
lemma cardinal_rel_UN_le:
assumes K: "InfCardâMâ(K)"
shows "(âi. iâK â¹ |X(i)|âMâ ⤠K) â¹ |âiâK. X(i)|âMâ ⤠K"
proof (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff Pi_assumptions)
have "M(f) â¹ M(λxâ(âxâK. X(x)). â¨Î¼ i. x â X(i), f ` (μ i. x â X(i)) ` xâ©)" for f
using lam_m_replacement X_witness_in_M Least_closed' Pi_assumptions UN_closed
by (rule_tac lam_closed) (auto dest:transM)
note types = this Pi_assumptions UN_closed
have [intro]: "Ord(K)" by (blast intro: InfCard_rel_is_Card_rel
Card_rel_is_Ord K types)
interpret pii:M_Pi_assumptions_choice _ K "λi. injâMâ(X(i), K)"
using inj_replacement Pi_assumptions transM[of _ K]
by unfold_locales (simp_all del:mem_inj_abs)
assume asm:"âi. iâK â¹ X(i) â²âMâ K"
then
have "âi. iâK â¹ M(injâMâ(X(i), K))"
by (auto simp add: types)
interpret V:M_N_Perm M "ð±"
using separation_absolute replacement_absolute Union_ax_absolute
power_ax_absolute upair_ax_absolute
by unfold_locales auto
note bad_simps[simp del] = V.N.Forall_in_M_iff V.N.Equal_in_M_iff
V.N.nonempty
have abs:"inj_rel(ð±,x,y) = inj(x,y)" for x y
using V.N.inj_rel_char by simp
from asm
have "âi. iâK â¹ âf[M]. f â injâMâ(X(i), K)"
by (simp add: types def_lepoll_rel)
then
obtain f where "f â (âiâK. injâMâ(X(i), K))" "M(f)"
using pii.AC_Pi_rel pii.Pi_rel_char by auto
with abs
have f:"f â (âiâK. inj(X(i), K))"
using Pi_weaken_type[OF _ V.inj_rel_transfer, of f K X "λ_. K"]
Pi_assumptions by simp
{ fix z
assume z: "z â (âiâK. X(i))"
then obtain i where i: "i â K" "Ord(i)" "z â X(i)"
by (blast intro: Ord_in_Ord [of K])
hence "(μ i. z â X(i)) ⤠i" by (fast intro: Least_le)
hence "(μ i. z â X(i)) < K" by (best intro: lt_trans1 ltI i)
hence "(μ i. z â X(i)) â K" and "z â X(μ i. z â X(i))"
by (auto intro: LeastI ltD i)
} note mems = this
have "(âiâK. X(i)) â²âMâ K à K"
proof (simp add:types def_lepoll_rel)
show "âf[M]. f â inj(âxâK. X(x), K Ã K)"
apply (rule rexI)
apply (rule_tac c = "λz. â¨Î¼ i. z â X(i), f ` (μ i. z â X(i)) ` zâ©"
and d = "λâ¨i,jâ©. converse (f`i) ` j" in lam_injective)
apply (force intro: f inj_is_fun mems apply_type Perm.left_inverse)+
apply (simp add:types â¹M(f)âº)
done
qed
also have "... ââMâ K"
by (simp add: K InfCard_rel_square_eq InfCard_rel_is_Card_rel
Card_rel_cardinal_rel_eq types)
finally have "(âiâK. X(i)) â²âMâ K" by (simp_all add:types)
then
show ?thesis
by (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff types)
qed
end
end
Theory FiniteFun_Relative
sectionâ¹Relativization of Finite Functionsâº
theory FiniteFun_Relative
imports
Lambda_Replacement
begin
lemma FiniteFunI :
assumes "fâFin(AÃB)" "function(f)"
shows "f â A -||> B"
using assms
proof(induct)
case 0
then show ?case using emptyI by simp
next
case (cons p f)
moreover
from assms this
have "fst(p)âA" "snd(p)âB" "function(f)"
using snd_type[OF â¹pâ_âº] function_subset
by auto
moreover
from â¹function(cons(p,f))⺠â¹pâf⺠â¹pâ_âº
have "fst(p)âdomain(f)"
unfolding function_def
by force
ultimately
show ?case
using consI[of "fst(p)" _ "snd(p)"]
by auto
qed
subsectionâ¹The set of finite binary sequencesâº
textâ¹We implement the poset for adding one Cohen real, the set
$2^{<\omega}$ of finite binary sequences.âº
definition
seqspace :: "[i,i] â i" (â¹_â<_â⺠[100,1]100) where
"Bâ<αâ â¡ ânâα. (nâB)"
schematic_goal seqspace_fm_auto:
assumes
"i â nat" "j â nat" "hânat" "env â list(A)"
shows
"(âomâA. omega(##A,om) ⧠nth(i,env) â om ⧠is_funspace(##A, nth(i,env), nth(h,env), nth(j,env))) â· (A, env ⨠(?sqsprp(i,j,h)))"
unfolding is_funspace_def
by (insert assms ; (rule iff_sats | simp)+)
synthesize "seqspace_rel" from_schematic "seqspace_fm_auto"
arity_theorem for "seqspace_rel_fm"
lemma seqspaceI[intro]: "nâα â¹ f:nâB â¹ fâBâ<αâ"
unfolding seqspace_def by blast
lemma seqspaceD[dest]: "fâBâ<αâ â¹ ânâα. f:nâB"
unfolding seqspace_def by blast
locale M_seqspace = M_trancl + M_replacement +
assumes
seqspace_replacement: "M(B) â¹ strong_replacement(M,λn z. nânat ⧠is_funspace(M,n,B,z))"
begin
lemma seqspace_closed:
"M(B) â¹ M(Bâ<Ïâ)"
unfolding seqspace_def using seqspace_replacement[of B] RepFun_closed2
by simp
end
subsectionâ¹Representation of finite functionsâº
textâ¹A function $f\in A\to_{\mathit{fin}}B$ can be represented by a function
$g\in |f| \to A\times B$. It is clear that $f$ can be represented by
any $g' = g \cdot \pi$, where $\pi$ is a permutation $\pi\in dom(g)\to dom(g)$.
We use this representation of $A\to_{\mathit{fin}}B$ to prove that our model is
closed under $\_\to_{\mathit{fin}}\_$.âº
textâ¹A function $g\in n\to A\times B$ that is functional in the first components.âº
definition cons_like :: "i â o" where
"cons_like(f) â¡ â iâdomain(f) . âjâi . fst(f`i) â fst(f`j)"
relativize "cons_like" "cons_like_rel"
lemma (in M_seqspace) cons_like_abs:
"M(f) â¹ cons_like(f) â· cons_like_rel(M,f)"
unfolding cons_like_def cons_like_rel_def
using fst_abs
by simp
definition FiniteFun_iso :: "[i,i,i,i,i] â o" where
"FiniteFun_iso(A,B,n,g,f) â¡ (â iân . g`i â f) ⧠(â abâf. (â iân. g`i=ab))"
textâ¹From a function $g\in n \to A\times B$ we obtain a finite function in \<^term>â¹A-||>Bâº.âº
definition to_FiniteFun :: "i â i" where
"to_FiniteFun(f) â¡ {f`i. iâdomain(f)}"
definition FiniteFun_Repr :: "[i,i] â i" where
"FiniteFun_Repr(A,B) â¡ {f â (AÃB)â<Ïâ . cons_like(f) }"
locale M_FiniteFun = M_seqspace +
assumes
cons_like_separation : "separation(M,λf. cons_like_rel(M,f))"
and
separation_is_function : "separation(M, is_function(M))"
begin
lemma supset_separation: "separation(M, λ x. âa. âb. x = â¨a,b⩠⧠b â a)"
using separation_pair separation_subset lam_replacement_fst lam_replacement_snd
by simp
lemma to_finiteFun_replacement: "strong_replacement(M, λx y. y = range(x))"
using lam_replacement_range lam_replacement_imp_strong_replacement
by simp
lemma fun_range_eq: "fâAâB â¹ {f`i . iâdomain(f) } = range(f)"
using ZF_Library.range_eq_image[of f] domain_of_fun image_fun func.apply_rangeI
by simp
lemma FiniteFun_fst_type:
assumes "hâA-||>B" "pâh"
shows "fst(p)âdomain(h)"
using assms
by(induct h, auto)
lemma FinFun_closed:
"M(A) â¹ M(B) â¹ M(â{nâAÃB . nâÏ})"
using cartprod_closed seqspace_closed
unfolding seqspace_def by simp
lemma cons_like_lt :
assumes "nâÏ" "fâsucc(n)âAÃB" "cons_like(f)"
shows "restrict(f,n)ânâAÃB" "cons_like(restrict(f,n))"
using assms
proof (auto simp add: le_imp_subset restrict_type2)
from â¹fâ_âº
have D:"domain(restrict(f,n)) = n" "domain(f) = succ(n)"
using domain_of_fun domain_restrict by auto
{
fix i j
assume "iâdomain(restrict(f,n))" (is "iâ?D") "jâi"
with â¹nâ_⺠D
have "jâ?D" "iân" "jân" using Ord_trans[of j] by simp_all
with D â¹cons_like(f)⺠â¹jân⺠â¹iân⺠â¹jâiâº
have "fst(restrict(f,n)`i) â fst(restrict(f,n)`j)"
using restrict_if unfolding cons_like_def by auto
}
then show "cons_like(restrict(f,n))"
unfolding cons_like_def by auto
qed
textâ¹A finite function \<^term>â¹f â A -||> B⺠can be represented by a
function $g \in n \to A \times B$, with $n=|f|$.âº
lemma FiniteFun_iso_intro1:
assumes "f â (A -||> B)"
shows "ânâÏ . âgânâAÃB. FiniteFun_iso(A,B,n,g,f) ⧠cons_like(g)"
using assms
proof(induct f,force simp add:emptyI FiniteFun_iso_def cons_like_def)
case (consI a b h)
then obtain n g where
HI: "nâÏ" "gânâAÃB" "FiniteFun_iso(A,B,n,g,h)" "cons_like(g)" by auto
let ?G="λ i â succ(n) . if i=n then <a,b> else g`i"
from HI â¹aâ_⺠â¹bâ_âº
have G: "?G â succ(n)âAÃB"
by (auto intro:lam_type)
have "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))"
unfolding FiniteFun_iso_def
proof(intro conjI)
{
fix i
assume "iâsucc(n)"
then consider "i=n" | "iânâ§iâ n" by auto
then have "?G ` i â cons(<a,b>,h)"
using HI
by(cases,simp;auto simp add:HI FiniteFun_iso_def)
}
then show "âiâsucc(n). ?G ` i â cons(â¨a, bâ©, h)" ..
next
{ fix ab'
assume "ab' â cons(<a,b>,h)"
then
consider "ab' = <a,b>" | "ab' â h" using cons_iff by auto
then
have "âi â succ(n) . ?G`i = ab'" unfolding FiniteFun_iso_def
proof(cases,simp)
case 2
with HI obtain i
where "iân" "g`i=ab'" unfolding FiniteFun_iso_def by auto
with HI show ?thesis using ltI[OF â¹iâ_âº] by auto
qed
}
then
show "âabâcons(â¨a, bâ©, h). âiâsucc(n). ?G`i = ab" ..
qed
with HI G
have 1: "?Gâsucc(n)âAÃB" "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))" "succ(n)âÏ" by simp_all
have "cons_like(?G)"
proof -
from â¹?Gâ_⺠â¹gâ_âº
have "domain(g) = n" using domain_of_fun by simp
{
fix i j
assume "iâdomain(?G)" "jâi"
with â¹nâ_âº
have "jân" using Ord_trans[of j _ n] by auto
from â¹iâ_⺠consider (a) "i=n ⧠iân" | (b) "iân" by auto
then
have " fst(?G`i) â fst(?G`j)"
proof(cases)
case a
with â¹jân⺠HI
have "?G`i=<a,b>" "?G`j=g`j" "g`jâh"
unfolding FiniteFun_iso_def by auto
with â¹aâ_⺠â¹hâ_âº
show ?thesis using FiniteFun_fst_type by auto
next
case b
with â¹iân⺠â¹jâi⺠â¹jân⺠HI â¹domain(g) = nâº
show ?thesis unfolding cons_like_def
using mem_not_refl by auto
qed
}
then show ?thesis unfolding cons_like_def by auto
qed
with 1 show ?case by auto
qed
textâ¹All the representations of \<^term>â¹fâA-||>B⺠are equal.âº
lemma FiniteFun_isoD :
assumes "nâÏ" "gânâAÃB" "fâA-||>B" "FiniteFun_iso(A,B,n,g,f)"
shows "to_FiniteFun(g) = f"
proof
show "to_FiniteFun(g) â f"
proof
fix ab
assume "abâto_FiniteFun(g)"
moreover
note assms
moreover from calculation
obtain i where "iân" "g`i=ab" "abâAÃB"
unfolding to_FiniteFun_def using domain_of_fun by auto
ultimately
show "abâf" unfolding FiniteFun_iso_def by auto
qed
next
show "f â to_FiniteFun(g)"
proof
fix ab
assume "abâf"
with assms
obtain i where "iân" "g`i=ab" "abâAÃB"
unfolding FiniteFun_iso_def by auto
with assms
show "ab â to_FiniteFun(g)"
unfolding to_FiniteFun_def
using domain_of_fun by auto
qed
qed
lemma to_FiniteFun_succ_eq :
assumes "nâÏ" "fâsucc(n) â A"
shows "to_FiniteFun(f) = cons(f`n,to_FiniteFun(restrict(f,n)))"
using assms domain_restrict domain_of_fun
unfolding to_FiniteFun_def by auto
textâ¹If $g \in n\to A\times B$ is \<^term>â¹cons_likeâº, then it is a representation of
\<^term>â¹to_FiniteFun(g)âº.âº
lemma FiniteFun_iso_intro_to:
assumes "nâÏ" "gânâAÃB" "cons_like(g)"
shows "to_FiniteFun(g) â (A -||> B) ⧠FiniteFun_iso(A,B,n,g,to_FiniteFun(g))"
using assms
proof(induct n arbitrary:g rule:nat_induct)
case 0
fix g
assume "gâ0âAÃB"
then
have "g=0" by simp
then have "to_FiniteFun(g)=0" unfolding to_FiniteFun_def by simp
then show "to_FiniteFun(g) â (A -||> B) ⧠FiniteFun_iso(A,B,0,g,to_FiniteFun(g))"
using emptyI unfolding FiniteFun_iso_def by simp
next
case (succ x)
fix g
let ?g'="restrict(g,x)"
assume "gâsucc(x)âAÃB" "cons_like(g)"
with succ.hyps â¹gâ_âº
have "cons_like(?g')" "?g' â xâAÃB" "g`xâAÃB" "domain(g) = succ(x)"
using cons_like_lt succI1 apply_funtype domain_of_fun by simp_all
with succ.hyps â¹?g'â_⺠â¹xâÏâº
have HI:
"to_FiniteFun(?g') â A -||> B" (is "(?h) â _")
"FiniteFun_iso(A,B,x,?g',to_FiniteFun(?g'))"
by simp_all
then
have "fst(g`x) â domain(?h)"
proof -
{
assume "fst(g`x) â domain(?h)"
with HI â¹xâ_âº
obtain i b
where "iâx" "<fst(?g'`i),b>â?h" "i<x" "fst(g`x) = fst(?g'`i)"
unfolding FiniteFun_iso_def using ltI by auto
with â¹cons_like(g)⺠â¹domain(g) = _âº
have False
unfolding cons_like_def by auto
}
then show ?thesis ..
qed
with HI assms â¹g`xâ_âº
have "cons(g`x,?h) â A-||>B" (is "?h' â_") using consI by auto
have "FiniteFun_iso(A,B,succ(x),g,?h')"
unfolding FiniteFun_iso_def
proof
{ fix i
assume "iâsucc(x)"
with â¹xâ_⺠consider (a) "i=x"| (b) "iâxâ§iâ x" by auto
then have "g`iâ ?h'"
proof(cases,simp)
case b
with â¹FiniteFun_iso(_,_,_,?g',?h)âº
show ?thesis unfolding FiniteFun_iso_def by simp
qed
}
then show "âiâsucc(x). g ` i â cons(g ` x, ?h)" ..
next
{
fix ab
assume "abâ?h'"
then consider "ab=g`x" | "ab â ?h" using cons_iff by auto
then
have "âi â succ(x) . g`i = ab" unfolding FiniteFun_iso_def
proof(cases,simp)
case 2
with HI obtain i
where 2:"iâx" "?g'`i=ab" unfolding FiniteFun_iso_def by auto
with â¹xâ_âº
have "iâ x" "iâsucc(x)" using ltI[OF â¹iâ_âº] by auto
with 2 HI show ?thesis by auto
qed
} then show "âabâcons(g ` x, ?h). âiâsucc(x). g ` i = ab" ..
qed
with â¹?h'â_âº
show "to_FiniteFun(g) â A -||>B ⧠FiniteFun_iso(A,B,succ(x),g,to_FiniteFun(g))"
using to_FiniteFun_succ_eq[OF â¹xâ_⺠â¹gâ_âº,symmetric] by auto
qed
lemma FiniteFun_iso_intro2:
assumes "nâÏ" "fânâAÃB" "cons_like(f)"
shows "â g â (A -||> B) . FiniteFun_iso(A,B,n,f,g)"
using assms FiniteFun_iso_intro_to by blast
lemma FiniteFun_eq_range_Repr :
shows "{range(h) . h â FiniteFun_Repr(A,B) } = {to_FiniteFun(h) . h â FiniteFun_Repr(A,B) }"
unfolding FiniteFun_Repr_def to_FiniteFun_def seqspace_def
using fun_range_eq
by(intro equalityI subsetI,auto)
lemma FiniteFun_eq_to_FiniteFun_Repr :
shows "A-||>B = {to_FiniteFun(h) . h â FiniteFun_Repr(A,B) } "
(is "?Y=?X")
proof
{
fix f
assume "fâA-||>B"
then obtain n g where
1: "nâÏ" "gânâAÃB" "FiniteFun_iso(A,B,n,g,f)" "cons_like(g)"
using FiniteFun_iso_intro1 by blast
with â¹fâ_âº
have "cons_like(g)" "f=to_FiniteFun(g)" "domain(g) = n" "gâFiniteFun_Repr(A,B)"
using FiniteFun_isoD domain_of_fun
unfolding FiniteFun_Repr_def
by auto
with 1 have "fâ?X"
by auto
} then show "?Yâ?X" ..
next
{
fix f
assume "fâ?X"
then obtain g where
A:"gâFiniteFun_Repr(A,B)" "f=to_FiniteFun(g)" "cons_like(g)"
using RepFun_iff unfolding FiniteFun_Repr_def by auto
then obtain n where "nâÏ" "gânâAÃB" "domain(g) = n"
unfolding FiniteFun_Repr_def using domain_of_fun by force
with A
have "fâ?Y"
using FiniteFun_iso_intro_to by simp
} then show "?Xâ?Y" ..
qed
lemma FiniteFun_Repr_closed :
assumes "M(A)" "M(B)"
shows "M(FiniteFun_Repr(A,B))"
unfolding FiniteFun_Repr_def
using assms cartprod_closed
seqspace_closed separation_closed cons_like_abs cons_like_separation
by simp
lemma to_FiniteFun_closed:
assumes "M(A)" "fâA"
shows "M(range(f))"
using assms transM[of _ A] by simp
lemma To_FiniteFun_Repr_closed :
assumes "M(A)" "M(B)"
shows "M({range(h) . h â FiniteFun_Repr(A,B) })"
using assms FiniteFun_Repr_closed
RepFun_closed to_finiteFun_replacement
to_FiniteFun_closed[OF FiniteFun_Repr_closed]
by simp
lemma FiniteFun_closed[intro,simp] :
assumes "M(A)" "M(B)"
shows "M(A -||> B)"
using assms To_FiniteFun_Repr_closed FiniteFun_eq_to_FiniteFun_Repr
FiniteFun_eq_range_Repr
by simp
end
end >
Theory ZF_Library_Relative
sectionâ¹Library of basic $\mathit{ZF}$ results\label{sec:zf-lib}âº
theory ZF_Library_Relative
imports
Aleph_Relative
Cardinal_AC_Relative
FiniteFun_Relative
begin
no_notation sum (infixr â¹+⺠65)
notation oadd (infixl â¹+⺠65)
lemma (in M_cardinal_arith_jump) csucc_rel_cardinal_rel:
assumes "Ord(κ)" "M(κ)"
shows "(|κ|âMââ§+)âMâ = (κâ§+)âMâ"
proof (intro le_anti_sym)
from assms
have hips:"M((κâ§+)âMâ)" "Ord((κâ§+)âMâ)" "κ < (κâ§+)âMâ"
using Card_rel_csucc_rel[THEN Card_rel_is_Ord]
csucc_rel_basic by simp_all
then
show "(|κ|âMââ§+)âMâ ⤠(κâ§+)âMâ"
using Ord_cardinal_rel_le[THEN lt_trans1]
Card_rel_csucc_rel
unfolding csucc_rel_def
by (rule_tac Least_antitone) (assumption, simp_all add:assms)
from assms
have "κ < L" if "CardâMâ(L)" "|κ|âMâ < L" "M(L)" for L
using that
Card_rel_is_Ord leI Card_rel_le_iff[of κ L]
by (rule_tac ccontr, auto dest:not_lt_imp_le) (fast dest: le_imp_not_lt)
with hips
show "(κâ§+)âMâ ⤠(|κ|âMââ§+)âMâ"
using Ord_cardinal_rel_le[THEN lt_trans1] Card_rel_csucc_rel
unfolding csucc_rel_def
by (rule_tac Least_antitone) (assumption, auto simp add:assms)
qed
lemma (in M_cardinal_arith_jump) csucc_rel_le_mono:
assumes "κ ⤠ν" "M(κ)" "M(ν)"
shows "(κâ§+)âMâ ⤠(νâ§+)âMâ"
proof (cases "κ = ν")
case True
with assms
show ?thesis using Card_rel_csucc_rel [THEN Card_rel_is_Ord] by simp
next
case False
with assms
have "κ < ν" using le_neq_imp_lt by simp
show ?thesis
proof (rule ccontr)
assume "¬ (κâ§+)âMâ ⤠(νâ§+)âMâ"
with assms
have "(νâ§+)âMâ < (κâ§+)âMâ"
using Card_rel_csucc_rel[THEN Card_rel_is_Ord] le_Ord2 lt_Ord
by (intro not_le_iff_lt[THEN iffD1]) auto
with assms
have "(νâ§+)âMâ ⤠|κ|âMâ"
using le_Ord2[THEN Card_rel_csucc_rel, of κ ν]
Card_rel_lt_csucc_rel_iff[of "(νâ§+)âMâ" "|κ|âMâ", THEN iffD1]
csucc_rel_cardinal_rel[OF lt_Ord] leI[of "(νâ§+)âMâ" "(κâ§+)âMâ"]
by simp
with assms
have "(νâ§+)âMâ ⤠κ"
using Ord_cardinal_rel_le[OF lt_Ord] le_trans by auto
with assms
have "ν < κ"
using csucc_rel_basic le_Ord2[THEN Card_rel_csucc_rel, of κ ν] Card_rel_is_Ord
le_Ord2
by (rule_tac j="(νâ§+)âMâ" in lt_trans2) simp_all
with â¹Îº < νâº
show "False" using le_imp_not_lt leI by blast
qed
qed
lemma (in M_cardinal_AC) cardinal_rel_succ_not_0: "|A|âMâ = succ(n) â¹ M(A) â¹ M(n) â¹ A â 0"
by auto
reldb_add functional "Finite" "Finite"
relativize functional "Finite_to_one" "Finite_to_one_rel" external
notation Finite_to_one_rel (â¹Finite'_to'_oneâ_â'(_,_')âº)
abbreviation
Finite_to_one_r_set :: "[i,i,i] â i" (â¹Finite'_to'_oneâ_â'(_,_')âº) where
"Finite_to_oneâMâ(X,Y) â¡ Finite_to_one_rel(##M,X,Y)"
locale M_ZF_library = M_cardinal_arith + M_aleph + M_FiniteFun + M_replacement_extra
begin
lemma Finite_Collect_imp: "Finite({xâX . Q(x)}) â¹ Finite({xâX . M(x) ⧠Q(x)})"
(is "Finite(?A) â¹ Finite(?B)")
using subset_Finite[of ?B ?A] by auto
lemma Finite_to_one_relI[intro]:
assumes "f:XââMâY" "ây. yâY â¹ Finite({xâX . f`x = y})"
and types:"M(f)" "M(X)" "M(Y)"
shows "f â Finite_to_oneâMâ(X,Y)"
using assms Finite_Collect_imp unfolding Finite_to_one_rel_def
by (simp)
lemma Finite_to_one_relI'[intro]:
assumes "f:XââMâY" "ây. yâY â¹ Finite({xâX . M(x) ⧠f`x = y})"
and types:"M(f)" "M(X)" "M(Y)"
shows "f â Finite_to_oneâMâ(X,Y)"
using assms unfolding Finite_to_one_rel_def
by (simp)
lemma Finite_to_one_relD[dest]:
"f â Finite_to_oneâMâ(X,Y) â¹f:XââMâY"
"f â Finite_to_oneâMâ(X,Y) â¹ yâY â¹ M(Y) â¹ Finite({xâX . M(x) ⧠f`x = y})"
unfolding Finite_to_one_rel_def by simp_all
lemma Diff_bij_rel:
assumes "âAâF. X â A"
and types: "M(F)" "M(X)" shows "(λAâF. A-X) â bijâMâ(F, {A-X. AâF})"
using assms def_inj_rel def_surj_rel unfolding bij_rel_def
apply (auto)
apply (subgoal_tac "M(λAâF. A - X)" "M({A - X . A â F})")
apply (auto simp add:mem_function_space_rel_abs)
apply (rule_tac lam_type, auto)
prefer 4
apply (subgoal_tac "M(λAâF. A - X)" "M({A - X . A â F})")
apply(tactic â¹distinct_subgoals_tacâº)
apply (auto simp add:mem_function_space_rel_abs)
apply (rule_tac lam_type, auto) prefer 3
apply (subst subset_Diff_Un[of X])
apply auto
proof -
from types
show "M({A - X . A â F})"
using diff_replacement
by (rule_tac RepFun_closed) (auto dest:transM[of _ F])
from types
show "M(λAâF. A - X)"
using Pair_diff_replacement
by (rule_tac lam_closed, auto dest:transM)
qed
lemma function_space_rel_nonempty:
assumes "bâB" and types: "M(B)" "M(A)"
shows "(λxâA. b) : A ââMâ B"
proof -
note assms
moreover from this
have "M(λxâA. b)"
using tag_replacement by (rule_tac lam_closed, auto dest:transM)
ultimately
show ?thesis
by (simp add:mem_function_space_rel_abs)
qed
lemma mem_function_space_rel:
assumes "f â A ââMâ y" "M(A)" "M(y)"
shows "f â A â y"
using assms function_space_rel_char by simp
lemmas range_fun_rel_subset_codomain = range_fun_subset_codomain[OF mem_function_space_rel]
end
context M_Pi_assumptions
begin
lemma mem_Pi_rel: "f â PiâMâ(A,B) â¹ f â Pi(A, B)"
using trans_closed mem_Pi_rel_abs
by force
lemmas Pi_rel_rangeD = Pi_rangeD[OF mem_Pi_rel]
lemmas rel_apply_Pair = apply_Pair[OF mem_Pi_rel]
lemmas rel_apply_rangeI = apply_rangeI[OF mem_Pi_rel]
lemmas Pi_rel_range_eq = Pi_range_eq[OF mem_Pi_rel]
lemmas Pi_rel_vimage_subset = Pi_vimage_subset[OF mem_Pi_rel]
end
context M_ZF_library
begin
lemma mem_bij_rel: "â¦f â bijâMâ(A,B); M(A); M(B)⧠⹠fâbij(A,B)"
using bij_rel_char by simp
lemma mem_inj_rel: "â¦f â injâMâ(A,B); M(A); M(B)⧠⹠fâinj(A,B)"
using inj_rel_char by simp
lemma mem_surj_rel: "â¦f â surjâMâ(A,B); M(A); M(B)⧠⹠fâsurj(A,B)"
using surj_rel_char by simp
lemmas rel_apply_in_range = apply_in_range[OF _ _ mem_function_space_rel]
lemmas rel_range_eq_image = ZF_Library.range_eq_image[OF mem_function_space_rel]
lemmas rel_Image_sub_codomain = Image_sub_codomain[OF mem_function_space_rel]
lemma rel_inj_to_Image: "â¦f:AââMâB; f â injâMâ(A,B); M(A); M(B)⧠⹠f â injâMâ(A,f``A)"
using inj_to_Image[OF mem_function_space_rel mem_inj_rel]
transM[OF _ function_space_rel_closed] by simp
lemma inj_rel_imp_surj_rel:
fixes f b
defines [simp]: "ifx(x) â¡ if xârange(f) then converse(f)`x else b"
assumes "f â injâMâ(B,A)" "bâB" and types: "M(f)" "M(B)" "M(A)"
shows "(λxâA. ifx(x)) â surjâMâ(A,B)"
proof -
from types and â¹bâBâº
have "M(λxâA. ifx(x))"
using ifx_replacement by (rule_tac lam_closed) (auto dest:transM)
with assms(2-)
show ?thesis
using inj_imp_surj mem_surj_abs by simp
qed
lemma function_space_rel_disjoint_Un:
assumes "f â AââMâB" "g â CââMâD" "A â© C = 0"
and types:"M(A)" "M(B)" "M(C)" "M(D)"
shows "f ⪠g â (A ⪠C)ââMâ (B ⪠D)"
using assms fun_Pi_disjoint_Un[OF mem_function_space_rel
mem_function_space_rel, OF assms(1) _ _ assms(2)]
function_space_rel_char by auto
lemma restrict_eq_imp_Un_into_function_space_rel:
assumes "f â AââMâB" "g â CââMâD" "restrict(f, A â© C) = restrict(g, A â© C)"
and types:"M(A)" "M(B)" "M(C)" "M(D)"
shows "f ⪠g â (A ⪠C)ââMâ (B ⪠D)"
using assms restrict_eq_imp_Un_into_Pi[OF mem_function_space_rel
mem_function_space_rel, OF assms(1) _ _ assms(2)]
function_space_rel_char by auto
lemma lepoll_relD[dest]: "A â²âMâ B â¹ âf[M]. f â injâMâ(A, B)"
unfolding lepoll_rel_def .
lemma lepoll_relI[intro]: "f â injâMâ(A, B) â¹ M(f) â¹ A â²âMâ B"
unfolding lepoll_rel_def by blast
lemma eqpollD[dest]: "A ââMâ B â¹ âf[M]. f â bijâMâ(A, B)"
unfolding eqpoll_rel_def .
lemma bij_rel_imp_eqpoll_rel[intro]: "f â bijâMâ(A,B) â¹ M(f) â¹ A ââMâ B"
unfolding eqpoll_rel_def by blast
lemma restrict_bij_rel:
assumes "f â injâMâ(A,B)" "CâA"
and types:"M(A)" "M(B)" "M(C)"
shows "restrict(f,C)â bijâMâ(C, f``C)"
using assms restrict_bij inj_rel_char bij_rel_char by auto
lemma range_of_subset_eqpoll_rel:
assumes "f â injâMâ(X,Y)" "S â X"
and types:"M(X)" "M(Y)" "M(S)"
shows "S ââMâ f `` S"
using assms restrict_bij bij_rel_char
trans_inj_rel_closed[OF â¹f â injâMâ(X,Y)âº]
unfolding eqpoll_rel_def
by (rule_tac x="restrict(f,S)" in rexI) auto
lemmas inj_rel_is_fun = inj_is_fun[OF mem_inj_rel]
lemma inj_rel_bij_rel_range: "f â injâMâ(A,B) â¹ M(A) â¹ M(B) â¹ f â bijâMâ(A,range(f))"
using bij_rel_char inj_rel_char inj_bij_range by force
lemma bij_rel_is_inj_rel: "f â bijâMâ(A,B) â¹ M(A) â¹ M(B) â¹ f â injâMâ(A,B)"
unfolding bij_rel_def by simp
lemma inj_rel_weaken_type: "[| f â injâMâ(A,B); BâD; M(A); M(B); M(D) |] ==> f â injâMâ(A,D)"
using inj_rel_char inj_rel_is_fun inj_weaken_type by auto
lemma bij_rel_converse_bij_rel [TC]: "f â bijâMâ(A,B) â¹ M(A) â¹ M(B) ==> converse(f): bijâMâ(B,A)"
using bij_rel_char by force
lemma bij_rel_is_fun_rel: "f â bijâMâ(A,B) â¹ M(A) â¹ M(B) â¹ f â AââMâB"
using bij_rel_char mem_function_space_rel_abs bij_is_fun by simp
lemmas bij_rel_is_fun = bij_rel_is_fun_rel[THEN mem_function_space_rel]
lemma comp_bij_rel:
"g â bijâMâ(A,B) â¹ f â bijâMâ(B,C) â¹ M(A) â¹ M(B) â¹ M(C) â¹ (f O g) â bijâMâ(A,C)"
using bij_rel_char comp_bij by force
lemma inj_rel_converse_fun: "f â injâMâ(A,B) â¹ M(A) â¹ M(B) â¹ converse(f) â range(f)ââMâA"
proof -
assume "f â injâMâ(A,B)" "M(A)" "M(B)"
then
have "M(f)" "M(converse(f))" "M(range(f))" "fâinj(A,B)"
using inj_rel_char converse_closed range_closed
by auto
then
show ?thesis
using inj_converse_inj function_space_rel_char inj_is_fun â¹M(A)⺠by auto
qed
lemma fg_imp_bijective_rel:
assumes "f â A ââMâB" "g â BââMâA" "f O g = id(B)" "g O f = id(A)" "M(A)" "M(B)"
shows "f â bijâMâ(A,B)"
using assms mem_bij_abs fg_imp_bijective mem_function_space_rel_abs[THEN iffD2] function_space_rel_char
by auto
end
relativize functional "cexp" "cexp_rel" external
relationalize "cexp_rel" "is_cexp"
context M_ZF_library
begin
is_iff_rel for "cexp"
using is_cardinal_iff is_function_space_iff unfolding cexp_rel_def is_cexp_def
by (simp)
rel_closed for "cexp" unfolding cexp_rel_def by simp
end
synthesize "is_cexp" from_definition assuming "nonempty"
notation is_cexp_fm (â¹â
_ââ_â is _â
âº)
arity_theorem for "is_cexp_fm"
abbreviation
cexp_r :: "[i,i,iâo] â i" (â¹_ââ_,_ââº) where
"cexp_r(x,y,M) â¡ cexp_rel(M,x,y)"
abbreviation
cexp_r_set :: "[i,i,i] â i" (â¹_ââ_,_ââº) where
"cexp_r_set(x,y,M) â¡ cexp_rel(##M,x,y)"
context M_ZF_library
begin
lemma Card_rel_cexp_rel: "M(κ) â¹ M(ν) â¹ CardâMâ(κââν,Mâ)"
unfolding cexp_rel_def by simp
declare conj_cong[cong]
lemma eq_csucc_rel_ord:
"Ord(i) â¹ M(i) â¹ (iâ§+)âMâ = (|i|âMââ§+)âMâ"
using Card_rel_lt_iff Least_cong unfolding csucc_rel_def by auto
lemma lesspoll_succ_rel:
assumes "Ord(κ)" "M(κ)"
shows "κ â²âMâ (κâ§+)âMâ"
using csucc_rel_basic assms lt_Card_rel_imp_lesspoll_rel
Card_rel_csucc_rel lepoll_rel_iff_leqpoll_rel
by auto
lemma lesspoll_rel_csucc_rel:
assumes "Ord(κ)"
and types:"M(κ)" "M(d)"
shows "d âºâMâ (κâ§+)âMâ â· d â²âMâ κ"
proof
assume "d âºâMâ (κâ§+)âMâ"
moreover
note Card_rel_csucc_rel assms Card_rel_is_Ord
moreover from calculation
have "CardâMâ((κâ§+)âMâ)" "M((κâ§+)âMâ)" "Ord((κâ§+)âMâ)"
using Card_rel_is_Ord by simp_all
moreover from calculation
have "d âºâMâ (|κ|âMââ§+)âMâ" "d ââMâ |d|âMâ"
using eq_csucc_rel_ord[OF _ â¹M(κ)âº]
lesspoll_rel_imp_eqpoll_rel eqpoll_rel_sym by simp_all
moreover from calculation
have "|d|âMâ < (|κ|âMââ§+)âMâ"
using lesspoll_cardinal_lt_rel by simp
moreover from calculation
have "|d|âMâ â²âMâ |κ|âMâ"
using Card_rel_lt_csucc_rel_iff le_imp_lepoll_rel by simp
moreover from calculation
have "|d|âMâ â²âMâ κ"
using Ord_cardinal_rel_eqpoll_rel lepoll_rel_eq_trans
by simp
ultimately
show "d â²âMâ κ"
using eq_lepoll_rel_trans by simp
next
from â¹Ord(κ)âº
have "κ < (κâ§+)âMâ" "CardâMâ((κâ§+)âMâ)" "M((κâ§+)âMâ)"
using Card_rel_csucc_rel lt_csucc_rel_iff types eq_csucc_rel_ord[OF _ â¹M(κ)âº]
by simp_all
then
have "κ âºâMâ (κâ§+)âMâ"
using lt_Card_rel_imp_lesspoll_rel[OF _ â¹Îº <_âº] types by simp
moreover
assume "d â²âMâ κ"
ultimately
have "d â²âMâ (κâ§+)âMâ"
using Card_rel_csucc_rel types lesspoll_succ_rel lepoll_rel_trans â¹Ord(κ)âº
by simp
moreover
from â¹d â²âMâ κ⺠â¹Ord(κ)âº
have "(κâ§+)âMâ â²âMâ κ" if "d ââMâ (κâ§+)âMâ"
using eqpoll_rel_sym[OF that] types eq_lepoll_rel_trans[OF _ â¹dâ²âMâκâº]
by simp
moreover from calculation â¹Îº âºâMâ (κâ§+)âMââº
have False if "d ââMâ (κâ§+)âMâ"
using lesspoll_rel_irrefl[OF _ â¹M((κâ§+)âMâ)âº] lesspoll_rel_trans1 types that
by auto
ultimately
show "d âºâMâ (κâ§+)âMâ"
unfolding lesspoll_rel_def by auto
qed
lemma Infinite_imp_nats_lepoll:
assumes "Infinite(X)" "n â Ï"
shows "n â² X"
using â¹n â Ïâº
proof (induct)
case 0
then
show ?case using empty_lepollI by simp
next
case (succ x)
show ?case
proof -
from â¹Infinite(X)⺠and â¹x â Ïâº
have "¬ (x â X)"
using eqpoll_sym unfolding Finite_def by auto
with â¹x â² Xâº
obtain f where "f â inj(x,X)" "f â surj(x,X)"
unfolding bij_def eqpoll_def by auto
moreover from this
obtain b where "b â X" "âaâx. f`a â b"
using inj_is_fun unfolding surj_def by auto
ultimately
have "f â inj(x,X-{b})"
unfolding inj_def by (auto intro:Pi_type)
then
have "cons(â¨x, bâ©, f) â inj(succ(x), cons(b, X - {b}))"
using inj_extend[of f x "X-{b}" x b] unfolding succ_def
by (auto dest:mem_irrefl)
moreover from â¹bâXâº
have "cons(b, X - {b}) = X" by auto
ultimately
show "succ(x) â² X" by auto
qed
qed
lemma nepoll_imp_nepoll_rel :
assumes "¬ x â X" "M(x)" "M(X)"
shows "¬ (x ââMâ X)"
using assms unfolding eqpoll_def eqpoll_rel_def by simp
lemma Infinite_imp_nats_lepoll_rel:
assumes "Infinite(X)" "n â Ï"
and types: "M(X)"
shows "n â²âMâ X"
using â¹n â Ïâº
proof (induct)
case 0
then
show ?case using empty_lepoll_relI types by simp
next
case (succ x)
show ?case
proof -
from â¹Infinite(X)⺠and â¹x â Ïâº
have "¬ (x â X)" "M(x)" "M(succ(x))"
using eqpoll_sym unfolding Finite_def by auto
then
have "¬ (x ââMâ X)"
using nepoll_imp_nepoll_rel types by simp
with â¹x â²âMâ Xâº
obtain f where "f â injâMâ(x,X)" "f â surjâMâ(x,X)" "M(f)"
unfolding bij_rel_def eqpoll_rel_def by auto
with â¹M(X)⺠â¹M(x)âº
have "fâsurj(x,X)" "fâinj(x,X)"
using surj_rel_char by simp_all
moreover
from this
obtain b where "b â X" "âaâx. f`a â b"
using inj_is_fun unfolding surj_def by auto
moreover
from this calculation â¹M(x)âº
have "f â inj(x,X-{b})" "M(<x,b>)"
unfolding inj_def using transM[OF _ â¹M(X)âº]
by (auto intro:Pi_type)
moreover
from this
have "cons(â¨x, bâ©, f) â inj(succ(x), cons(b, X - {b}))" (is "?gâ_")
using inj_extend[of f x "X-{b}" x b] unfolding succ_def
by (auto dest:mem_irrefl)
moreover
note â¹M(<x,b>)⺠â¹M(f)⺠â¹bâX⺠â¹M(X)⺠â¹M(succ(x))âº
moreover from this
have "M(?g)" "cons(b, X - {b}) = X" by auto
moreover from calculation
have "?gâinj_rel(M,succ(x),X)"
using mem_inj_abs by simp
with â¹M(?g)âº
show "succ(x) â²âMâ X" using lepoll_relI by simp
qed
qed
lemma lepoll_rel_imp_lepoll: "A â²âMâ B â¹ M(A) â¹ M(B) â¹ A â² B"
unfolding lepoll_rel_def by auto
lemma zero_lesspoll_rel: assumes "0<κ" "M(κ)" shows "0 âºâMâ κ"
using assms eqpoll_rel_0_iff[THEN iffD1, of κ] eqpoll_rel_sym
unfolding lesspoll_rel_def lepoll_rel_def
by (auto simp add:inj_def)
lemma lepoll_rel_nat_imp_Infinite: "Ï â²âMâ X â¹ M(X) â¹ Infinite(X)"
using lepoll_nat_imp_Infinite lepoll_rel_imp_lepoll by simp
lemma InfCard_rel_imp_Infinite: "InfCardâMâ(κ) â¹ M(κ) â¹ Infinite(κ)"
using le_imp_lepoll_rel[THEN lepoll_rel_nat_imp_Infinite, of κ]
unfolding InfCard_rel_def by simp
lemma lt_surj_rel_empty_imp_Card_rel:
assumes "Ord(κ)" "âα. α < κ â¹ surjâMâ(α,κ) = 0"
and types:"M(κ)"
shows "CardâMâ(κ)"
proof -
{
define min where "minâ¡Î¼ x. âf[M]. f â bijâMâ(x,κ)"
moreover
note â¹Ord(κ)⺠â¹M(κ)âº
moreover
assume "|κ|âMâ < κ"
moreover from calculation
have "âf. f â bijâMâ(min,κ)"
using LeastI[of "λi. i ââMâ κ" κ, OF eqpoll_rel_refl]
unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
by (auto)
moreover from calculation
have "min < κ"
using lt_trans1[of min "μ i. M(i) ⧠(âf[M]. f â bijâMâ(i, κ))" κ]
Least_le[of "λi. i ââMâ κ" "|κ|âMâ", OF Ord_cardinal_rel_eqpoll_rel]
unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
by (simp)
moreover
note â¹min < κ â¹ surjâMâ(min,κ) = 0âº
ultimately
have "False"
unfolding bij_rel_def by simp
}
with assms
show ?thesis
using Ord_cardinal_rel_le[of κ] not_lt_imp_le[of "|κ|âMâ" κ] le_anti_sym
unfolding Card_rel_def by auto
qed
end
relativize functional "mono_map" "mono_map_rel" external
relationalize "mono_map_rel" "is_mono_map"
synthesize "is_mono_map" from_definition assuming "nonempty"
notation mono_map_rel (â¹mono'_mapâ_â'(_,_,_,_')âº)
abbreviation
mono_map_r_set :: "[i,i,i,i,i]âi" (â¹mono'_mapâ_â'(_,_,_,_')âº) where
"mono_mapâMâ(a,r,b,s) â¡ mono_map_rel(##M,a,r,b,s)"
context M_ZF_library
begin
lemma mono_map_rel_char:
assumes "M(a)" "M(b)"
shows "mono_mapâMâ(a,r,b,s) = {fâmono_map(a,r,b,s) . M(f)}"
using assms function_space_rel_char unfolding mono_map_rel_def mono_map_def
by auto
textâ¹Just a sample of porting results on \<^term>â¹mono_mapâºâº
lemma mono_map_rel_mono:
assumes
"f â mono_mapâMâ(A,r,B,s)" "B â C"
and types:"M(A)" "M(B)" "M(C)"
shows
"f â mono_mapâMâ(A,r,C,s)"
using assms mono_map_mono mono_map_rel_char by auto
lemma nats_le_InfCard_rel:
assumes "n â Ï" "InfCardâMâ(κ)"
shows "n ⤠κ"
using assms Ord_is_Transset
le_trans[of n Ï Îº, OF le_subset_iff[THEN iffD2]]
unfolding InfCard_rel_def Transset_def by simp
lemma nat_into_InfCard_rel:
assumes "n â Ï" "InfCardâMâ(κ)"
shows "n â κ"
using assms le_imp_subset[of Ï Îº]
unfolding InfCard_rel_def by auto
lemma Finite_lesspoll_rel_nat:
assumes "Finite(x)" "M(x)"
shows "x âºâMâ nat"
proof -
note assms
moreover from this
obtain n where "n â Ï" "M(n)" "x â n"
unfolding Finite_def by auto
moreover from calculation
obtain f where "f â bij(x,n)" "f: x-||>n"
using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
unfolding eqpoll_def by auto
ultimately
have "xââMâ n" unfolding eqpoll_rel_def by (auto dest:transM)
with assms and â¹M(n)âº
have "n ââMâ x" using eqpoll_rel_sym by simp
moreover
note â¹nâÏ⺠â¹M(n)âº
ultimately
show ?thesis
using assms eq_lesspoll_rel_trans[OF â¹xââMâ n⺠n_lesspoll_rel_nat]
by simp
qed
lemma Finite_cardinal_rel_in_nat [simp]:
assumes "Finite(A)" "M(A)" shows "|A|âMâ â Ï"
proof -
note assms
moreover from this
obtain n where "n â Ï" "M(n)" "A â n"
unfolding Finite_def by auto
moreover from calculation
obtain f where "f â bij(A,n)" "f: A-||>n"
using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
unfolding eqpoll_def by auto
ultimately
have "A ââMâ n" unfolding eqpoll_rel_def by (auto dest:transM)
with assms and â¹M(n)âº
have "n ââMâ A" using eqpoll_rel_sym by simp
moreover
note â¹nâÏ⺠â¹M(n)âº
ultimately
show ?thesis
using assms Least_le[of "λi. M(i) ⧠i ââMâ A" n]
lt_trans1[of _ n Ï, THEN ltD]
unfolding cardinal_rel_def Finite_def
by (auto dest!:naturals_lt_nat)
qed
lemma Finite_cardinal_rel_eq_cardinal:
assumes "Finite(A)" "M(A)" shows "|A|âMâ = |A|"
proof -
note assms
moreover from this
obtain n where "n â Ï" "M(n)" "A â n"
unfolding Finite_def by auto
moreover from this
have "|A| = n"
using cardinal_cong[of A n]
nat_into_Card[THEN Card_cardinal_eq, of n] by simp
moreover from calculation
obtain f where "f â bij(A,n)" "f: A-||>n"
using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
unfolding eqpoll_def by auto
ultimately
have "A ââMâ n" unfolding eqpoll_rel_def by (auto dest:transM)
with assms and â¹M(n)⺠â¹nâÏâº
have "|A|âMâ = n"
using cardinal_rel_cong[of A n]
nat_into_Card_rel[THEN Card_rel_cardinal_rel_eq, of n]
by simp
with â¹|A| = nâº
show ?thesis by simp
qed
lemma Finite_imp_cardinal_rel_cons:
assumes FA: "Finite(A)" and a: "aâA" and types:"M(A)" "M(a)"
shows "|cons(a,A)|âMâ = succ(|A|âMâ)"
using assms Finite_imp_cardinal_cons Finite_cardinal_rel_eq_cardinal by simp
lemma Finite_imp_succ_cardinal_rel_Diff:
assumes "Finite(A)" "a â A" "M(A)"
shows "succ(|A-{a}|âMâ) = |A|âMâ"
proof -
from assms
have inM: "M(A-{a})" "M(a)" "M(A)" by (auto dest:transM)
with â¹Finite(A)âº
have "succ(|A-{a}|âMâ) = succ(|A-{a}|)"
using Diff_subset[THEN subset_Finite,
THEN Finite_cardinal_rel_eq_cardinal, of A "{a}"] by simp
also from assms
have "⦠= |A|"
using Finite_imp_succ_cardinal_Diff by simp
also from assms
have "⦠= |A|âMâ" using Finite_cardinal_rel_eq_cardinal by simp
finally
show ?thesis .
qed
lemma InfCard_rel_Aleph_rel:
notes Aleph_rel_zero[simp]
assumes "Ord(α)"
and types: "M(α)"
shows "InfCardâMâ(âµâαââMâ)"
proof -
have "¬ (âµâαââMâ â Ï)"
proof (cases "α=0")
case True
then show ?thesis using mem_irrefl by auto
next
case False
with assms
have "Ï â âµâαââMâ" using Ord_0_lt[of α] ltD by (auto dest:Aleph_rel_increasing)
then show ?thesis using foundation by blast
qed
with assms
have "¬ (|âµâαââMâ|âMâ â Ï)"
using Card_rel_cardinal_rel_eq by auto
with assms
have "Infinite(âµâαââMâ)" using Ord_Aleph_rel by clarsimp
with assms
show ?thesis
using Inf_Card_rel_is_InfCard_rel by simp
qed
lemmas Limit_Aleph_rel = InfCard_rel_Aleph_rel[THEN InfCard_rel_is_Limit]
bundle Ord_dests = Limit_is_Ord[dest] Card_rel_is_Ord[dest]
bundle Aleph_rel_dests = Aleph_rel_cont[dest]
bundle Aleph_rel_intros = Aleph_rel_increasing[intro!]
bundle Aleph_rel_mem_dests = Aleph_rel_increasing[OF ltI, THEN ltD, dest]
lemma f_imp_injective_rel:
assumes "f â A ââMâ B" "âxâA. d(f ` x) = x" "M(A)" "M(B)"
shows "f â injâMâ(A, B)"
using assms
apply (simp (no_asm_simp) add: def_inj_rel)
apply (auto intro: subst_context [THEN box_equals])
done
lemma lam_injective_rel:
assumes "âx. x â A â¹ c(x) â B"
"âx. x â A â¹ d(c(x)) = x"
"âx[M]. M(c(x))" "lam_replacement(M,c)"
"M(A)" "M(B)"
shows "(λxâA. c(x)) â injâMâ(A, B)"
using assms function_space_rel_char lam_replacement_iff_lam_closed
by (rule_tac d = d in f_imp_injective_rel)
(auto simp add: lam_type)
lemma f_imp_surjective_rel:
assumes "f â A ââMâ B" "ây. y â B â¹ d(y) â A" "ây. y â B â¹ f ` d(y) = y"
"M(A)" "M(B)"
shows "f â surjâMâ(A, B)"
using assms
by (simp add: def_surj_rel, blast)
lemma lam_surjective_rel:
assumes "âx. x â A â¹ c(x) â B"
"ây. y â B â¹ d(y) â A"
"ây. y â B â¹ c(d(y)) = y"
"âx[M]. M(c(x))" "lam_replacement(M,c)"
"M(A)" "M(B)"
shows "(λxâA. c(x)) â surjâMâ(A, B)"
using assms function_space_rel_char lam_replacement_iff_lam_closed
by (rule_tac d = d in f_imp_surjective_rel)
(auto simp add: lam_type)
lemma lam_bijective_rel:
assumes "âx. x â A â¹ c(x) â B"
"ây. y â B â¹ d(y) â A"
"âx. x â A â¹ d(c(x)) = x"
"ây. y â B â¹ c(d(y)) = y"
"âx[M]. M(c(x))" "lam_replacement(M,c)"
"M(A)" "M(B)"
shows "(λxâA. c(x)) â bijâMâ(A, B)"
using assms
apply (unfold bij_rel_def)
apply (blast intro!: lam_injective_rel lam_surjective_rel)
done
lemma function_space_rel_eqpoll_rel_cong:
assumes
"A ââMâ A'" "B ââMâ B'" "M(A)" "M(A')" "M(B)" "M(B')"
shows
"A ââMâ B ââMâ A' ââMâ B'"
proof -
from assms(1)[THEN eqpoll_rel_sym] assms(2) assms lam_type
obtain f g where "f â bijâMâ(A',A)" "g â bijâMâ(B,B')"
by blast
with assms
have "converse(g) : bijâMâ(B', B)" "converse(f): bijâMâ(A, A')"
using bij_converse_bij by auto
let ?H="λ h â A ââMâ B . g O h O f"
let ?I="λ h â A' ââMâ B' . converse(g) O h O converse(f)"
have go:"g O F O f : A' ââMâ B'" if "F: A ââMâ B" for F
proof -
note assms â¹fâ_⺠â¹gâ_⺠that
moreover from this
have "g O F O f : A' â B'"
using bij_rel_is_fun[OF â¹gâ_âº] bij_rel_is_fun[OF â¹fâ_âº] comp_fun
mem_function_space_rel[OF â¹Fâ_âº]
by blast
ultimately
show "g O F O f : A' ââMâ B'"
using comp_closed function_space_rel_char bij_rel_char
by auto
qed
have og:"converse(g) O F O converse(f) : A ââMâ B" if "F: A' ââMâ B'" for F
proof -
note assms that â¹converse(f) â _⺠â¹converse(g) â _âº
moreover from this
have "converse(g) O F O converse(f) : A â B"
using bij_rel_is_fun[OF â¹converse(g)â_âº] bij_rel_is_fun[OF â¹converse(f)â_âº] comp_fun
mem_function_space_rel[OF â¹Fâ_âº]
by blast
ultimately
show "converse(g) O F O converse(f) : A ââMâ B" (is "?Gâ_")
using comp_closed function_space_rel_char bij_rel_char
by auto
qed
with go
have tc:"?H â (A ââMâ B) â (A'ââMâ B')" "?I â (A' ââMâ B') â (AââMâ B)"
using lam_type by auto
with assms â¹fâ_⺠â¹gâ_âº
have "M(g O x O f)" and "M(converse(g) O x O converse(f))" if "M(x)" for x
using bij_rel_char comp_closed that by auto
with assms â¹fâ_⺠â¹gâ_âº
have "M(?H)" "M(?I)"
using lam_replacement_iff_lam_closed[THEN iffD1,OF _ lam_replacement_comp']
bij_rel_char by auto
show ?thesis
unfolding eqpoll_rel_def
proof (intro rexI[of _ ?H] fg_imp_bijective_rel)
from og go
have "(âx. x â A' ââMâ B' â¹ converse(g) O x O converse(f) â A ââMâ B)"
by simp
next
show "M(A ââMâ B)" using assms by simp
next
show "M(A' ââMâ B')" using assms by simp
next
from og assms
have "?H O ?I = (λxâA' ââMâ B' . (g O converse(g)) O x O (converse(f) O f))"
using lam_cong[OF refl[of "A' ââMâ B'"]] comp_assoc comp_lam
by auto
also
have "... = (λxâA' ââMâ B' . id(B') O x O (id(A')))"
using left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel]] â¹fâ_âº
right_comp_inverse[OF bij_is_surj[OF mem_bij_rel]] â¹gâ_⺠assms
by auto
also
have "... = (λxâA' ââMâ B' . x)"
using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
right_comp_id[OF fun_is_rel[OF mem_function_space_rel]] assms
by auto
also
have "... = id(A'ââMâB')" unfolding id_def by simp
finally
show "?H O ?I = id(A' ââMâ B')" .
next
from go assms
have "?I O ?H = (λxâA ââMâ B . (converse(g) O g) O x O (f O converse(f)))"
using lam_cong[OF refl[of "A ââMâ B"]] comp_assoc comp_lam by auto
also
have "... = (λxâA ââMâ B . id(B) O x O (id(A)))"
using
left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel[OF â¹gâ_âº]]]
right_comp_inverse[OF bij_is_surj[OF mem_bij_rel[OF â¹fâ_âº]]] assms
by auto
also
have "... = (λxâA ââMâ B . x)"
using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
right_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
assms
by auto
also
have "... = id(AââMâB)" unfolding id_def by simp
finally
show "?I O ?H = id(A ââMâ B)" .
next
from assms tc â¹M(?H)⺠â¹M(?I)âº
show "?H â (AââMâ B) ââMâ (A'ââMâ B')" "M(?H)"
"?I â (A'ââMâ B') ââMâ (AââMâ B)"
using mem_function_space_rel_abs by auto
qed
qed
lemma curry_eqpoll_rel:
fixes ν1 ν2 κ
assumes "M(ν1)" "M(ν2)" "M(κ)"
shows "ν1 ââMâ (ν2 ââMâ κ) ââMâ ν1 à ν2 ââMâ κ"
unfolding eqpoll_rel_def
proof (intro rexI, rule lam_bijective_rel,
rule_tac [1-2] mem_function_space_rel_abs[THEN iffD2],
rule_tac [4] lam_type, rule_tac [8] lam_type,
rule_tac [8] mem_function_space_rel_abs[THEN iffD2],
rule_tac [11] lam_type, simp_all add:assms)
let ?cur="λx. λwâν1 à ν2. x ` fst(w) ` snd(w)"
fix f z
assume "f : ν1 ââMâ (ν2 ââMâ κ)"
moreover
note assms
moreover from calculation
have "M(ν2 ââMâ κ)"
using function_space_rel_closed by simp
moreover from calculation
have "M(f)" "f : ν1 â (ν2 ââMâ κ)"
using function_space_rel_char by (auto dest:transM)
moreover from calculation
have "x â ν1 â¹ f`x : ν2 â κ" for x
by (auto dest:transM intro!:mem_function_space_rel_abs[THEN iffD1])
moreover from this
show "(λaâν1. λbâν2. ?cur(f) ` â¨a, bâ©) = f"
using Pi_type[OF â¹f â ν1 â ν2 ââMâ κâº, of "λ_.ν2 â κ"] by simp
moreover
assume "z â ν1 à ν2"
moreover from calculation
have "f`fst(z): ν2 ââMâ κ" by simp
ultimately
show "f`fst(z)`snd(z) â κ"
using mem_function_space_rel_abs by (auto dest:transM)
next
let ?cur="λx. λwâν1 à ν2. x ` fst(w) ` snd(w)"
fix f
assume "f : ν1 à ν2 ââMâ κ"
with assms
show "?cur(λxâν1. λxaâν2. f ` â¨x, xaâ©) = f"
using function_space_rel_char mem_function_space_rel_abs
by (auto dest:transM intro:fun_extension)
fix x y
assume "xâν1" "yâν2"
with assms â¹f : ν1 à ν2 ââMâ κâº
show "f`â¨x,yâ© â κ"
using function_space_rel_char mem_function_space_rel_abs
by (auto dest:transM[of _ "ν1 à ν2 ââMâ κ"])
next
let ?cur="λx. λwâν1 à ν2. x ` fst(w) ` snd(w)"
note assms
moreover from this
show "âx[M]. M(?cur(x))"
using lam_replacement_fst lam_replacement_snd
lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
THEN [1] lam_replacement_hcomp2, where h="(`)", OF
lam_replacement_constant] lam_replacement_apply2
by (auto intro: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
moreover from calculation
show "x â ν1 ââMâ (ν2 ââMâ κ) â¹ M(?cur(x))" for x
by (auto dest:transM)
moreover from assms
show "lam_replacement(M, ?cur)"
using lam_replacement_Lambda_apply_fst_snd by simp
ultimately
show "M(λxâν1 ââMâ (ν2 ââMâ κ). ?cur(x))"
using lam_replacement_iff_lam_closed
by (auto dest:transM)
from assms
show "y â ν1 à ν2 ââMâ κ â¹ x â ν1 â¹ M(λxaâν2. y ` â¨x, xaâ©)" for x y
using lam_replacement_apply_const_id
by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
(auto dest:transM)
from assms
show "y â ν1 à ν2 ââMâ κ â¹ M(λxâν1. λxaâν2. y ` â¨x, xaâ©)" for y
using lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
OF lam_replacement_constant lam_replacement_const_id]
lam_replacement_Lambda_apply_Pair[of ν2]
by (auto dest:transM
intro!: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
qed
lemma Pow_rel_eqpoll_rel_function_space_rel:
fixes d X
notes bool_of_o_def [simp]
defines [simp]:"d(A) â¡ (λxâX. bool_of_o(xâA))"
assumes "M(X)"
shows "PowâMâ(X) ââMâ X ââMâ 2"
proof -
from assms
interpret M_Pi_assumptions M X "λ_. 2"
using Pi_replacement Pi_separation lam_replacement_identity
lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
Pi_replacement1[of _ 2] transM[of _ X] lam_replacement_constant
by unfold_locales auto
have "lam_replacement(M, λx. bool_of_o(xâA))" if "M(A)" for A
using that lam_replacement_if lam_replacement_constant
separation_in_constant by simp
with assms
have "lam_replacement(M, λx. d(x))"
using separation_in_constant[THEN [3] lam_replacement_if, of "λ_.1" "λ_.0"]
lam_replacement_identity lam_replacement_constant lam_replacement_Lambda_if_mem
by simp
show ?thesis
unfolding eqpoll_rel_def
proof (intro rexI, rule lam_bijective_rel)
fix A
assume "AâPowâMâ(X)"
moreover
note â¹M(X)âº
moreover from calculation
have "M(A)" by (auto dest:transM)
moreover
note â¹_ â¹ lam_replacement(M, λx. bool_of_o(xâA))âº
ultimately
show "d(A) : X ââMâ 2"
using function_space_rel_char lam_replacement_iff_lam_closed[THEN iffD1]
by (simp, rule_tac lam_type[of X "λx. bool_of_o(xâA)" "λ_. 2", simplified])
auto
from â¹AâPowâMâ(X)⺠â¹M(X)âº
show "{yâX. d(A)`y = 1} = A"
using Pow_rel_char by auto
next
fix f
assume "f: XââMâ 2"
with assms
have "f: Xâ 2" "M(f)" using function_space_rel_char by simp_all
then
show "d({y â X . f ` y = 1}) = f"
using apply_type[OF â¹f: Xâ2âº] by (force intro:fun_extension)
from â¹M(X)⺠â¹M(f)âº
show "{ya â X . f ` ya = 1} â PowâMâ(X)"
using Pow_rel_char separation_equal_apply by auto
next
from assms â¹lam_replacement(M, λx. d(x))âº
â¹âA. _ â¹ lam_replacement(M, λx. bool_of_o(xâA))âº
show "M(λxâPowâMâ(X). d(x))" "lam_replacement(M, λx. d(x))"
"âx[M]. M(d(x))"
using lam_replacement_iff_lam_closed[THEN iffD1] by auto
qed (auto simp:â¹M(X)âº)
qed
lemma Pow_rel_bottom: "M(B) â¹ 0 â PowâMâ(B)"
using Pow_rel_char by simp
lemma cantor_surj_rel:
assumes "M(f)" "M(A)"
shows "f â surjâMâ(A,PowâMâ(A))"
proof
assume "f â surjâMâ(A,PowâMâ(A))"
with assms
have "f â surj(A,PowâMâ(A))" using surj_rel_char by simp
moreover
note assms
moreover from this
have "M({x â A . x â f ` x})" "{x â A . x â f ` x} = A - {x â A . x â f ` x}"
using lam_replacement_apply[THEN [4] separation_in, of "λx. x"]
lam_replacement_identity lam_replacement_constant by auto
with â¹M(A)âº
have "{xâA . x â f`x} â PowâMâ(A)"
by (intro mem_Pow_rel_abs[THEN iffD2]) auto
ultimately
obtain d where "dâA" "f`d = {xâA . x â f`x}"
unfolding surj_def by blast
show False
proof (cases "d â f`d")
case True
note â¹d â f`dâº
also
note â¹f`d = {xâA . x â f`x}âº
finally
have "d â f`d" using â¹dâA⺠by simp
then
show False using â¹d â f ` d⺠by simp
next
case False
with â¹dâAâº
have "d â {xâA . x â f`x}" by simp
also from â¹f`d = â¦âº
have "⦠= f`d" by simp
finally
show False using â¹d â f`d⺠by simp
qed
qed
lemma cantor_inj_rel: "M(f) â¹ M(A) â¹ f â injâMâ(PowâMâ(A),A)"
using inj_rel_imp_surj_rel[OF _ Pow_rel_bottom, of f A A]
cantor_surj_rel[of "λxâA. if x â range(f) then converse(f) ` x else 0" A]
lam_replacement_if separation_in_constant[of "range(f)"]
lam_replacement_converse_app[THEN [5] lam_replacement_hcomp2]
lam_replacement_identity lam_replacement_constant
lam_replacement_iff_lam_closed by auto
end
end
Theory Replacement_Lepoll
sectionâ¹Lambda-replacements required for cardinal inequalitiesâº
theory Replacement_Lepoll
imports
ZF_Library_Relative
begin
definition
lepoll_assumptions1 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions1(M,A,F,S,fa,K,x,f,r) â¡ âxâS. strong_replacement(M, λy z. y â F(A, x) ⧠z = {â¨x, yâ©})"
definition
lepoll_assumptions2 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions2(M,A,F,S,fa,K,x,f,r) ⡠strong_replacement(M, λx z. z = Sigfun(x, F(A)))"
definition
lepoll_assumptions3 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions3(M,A,F,S,fa,K,x,f,r) ⡠strong_replacement(M, λx y. y = F(A, x))"
definition
lepoll_assumptions4 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions4(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx y. y = â¨x, minimum(r, F(A, x))â©)"
definition
lepoll_assumptions5 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions5(M,A,F,S,fa,K,x,f,r) â¡
strong_replacement(M, λx y. y = â¨x, μ i. x â F(A, i), f ` (μ i. x â F(A, i)) ` xâ©)"
definition
lepoll_assumptions6 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions6(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λy z. y â injâMâ(F(A, x),S) ⧠z = {â¨x, yâ©})"
definition
lepoll_assumptions7 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions7(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx y. y = injâMâ(F(A, x),S))"
definition
lepoll_assumptions8 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions8(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx z. z = Sigfun(x, λi. injâMâ(F(A, i),S)))"
definition
lepoll_assumptions9 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions9(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx y. y = â¨x, minimum(r, injâMâ(F(A, x),S))â©)"
definition
lepoll_assumptions10 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions10(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λx z. z = Sigfun(x, λk. if k â range(f) then F(A, converse(f) ` k) else 0))"
definition
lepoll_assumptions11 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions11(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx y. y = (if x â range(f) then F(A, converse(f) ` x) else 0))"
definition
lepoll_assumptions12 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions12(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λy z. y â F(A, converse(f) ` x) ⧠z = {â¨x, yâ©})"
definition
lepoll_assumptions13 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions13(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λx y. y = â¨x, minimum(r, if x â range(f) then F(A,converse(f) ` x) else 0)â©)"
definition
lepoll_assumptions14 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions14(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λx y. y = â¨x, μ i. x â (if i â range(f) then F(A, converse(f) ` i) else 0),
fa ` (μ i. x â (if i â range(f) then F(A, converse(f) ` i) else 0)) ` xâ©)"
definition
lepoll_assumptions15 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions15(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λy z. y â injâMâ(if x â range(f) then F(A, converse(f) ` x) else 0,K) ⧠z = {â¨x, yâ©})"
definition
lepoll_assumptions16 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions16(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement(M, λx y. y = injâMâ(if x â range(f) then F(A, converse(f) ` x) else 0,K))"
definition
lepoll_assumptions17 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions17(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λx z. z = Sigfun(x, λi. injâMâ(if i â range(f) then F(A, converse(f) ` i) else 0,K)))"
definition
lepoll_assumptions18 :: "[iâo,i,[i,i]âi,i,i,i,i,i,i] â o" where
"lepoll_assumptions18(M,A,F,S,fa,K,x,f,r) â¡ strong_replacement
(M, λx y. y = â¨x, minimum(r, injâMâ(if x â range(f) then F(A, converse(f) ` x) else 0,K))â©)"
lemmas lepoll_assumptions_defs[simp] = lepoll_assumptions1_def
lepoll_assumptions2_def lepoll_assumptions3_def lepoll_assumptions4_def
lepoll_assumptions5_def lepoll_assumptions6_def lepoll_assumptions7_def
lepoll_assumptions8_def lepoll_assumptions9_def lepoll_assumptions10_def
lepoll_assumptions11_def lepoll_assumptions12_def lepoll_assumptions13_def
lepoll_assumptions14_def lepoll_assumptions15_def lepoll_assumptions16_def
lepoll_assumptions17_def lepoll_assumptions18_def
definition if_range_F where
[simp]: "if_range_F(H,f,i) â¡ if i â range(f) then H(converse(f) ` i) else 0"
definition if_range_F_else_F where
"if_range_F_else_F(H,b,f,i) â¡ if b=0 then if_range_F(H,f,i) else H(i)"
lemma (in M_basic) lam_Least_assumption_general:
assumes
separations:
"âA'[M]. separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(F(A),b,f,i)â©)"
and
mem_F_bound:"âx c. xâF(A,c) â¹ c â range(f) ⪠U(A)"
and
types:"M(A)" "M(b)" "M(f)" "M(U(A))"
shows "lam_replacement(M,λx . μ i. x â if_range_F_else_F(F(A),b,f,i))"
proof -
have "âxâX. (μ i. x â if_range_F_else_F(F(A),b,f,i)) â
PowâMâ(â(X ⪠range(f) ⪠U(A)))" if "M(X)" for X
proof
fix x
assume "xâX"
moreover
note â¹M(X)âº
moreover from calculation
have "M(x)" by (auto dest:transM)
moreover
note assms
ultimately
show "(μ i. x â if_range_F_else_F(F(A),b,f,i)) â
PowâMâ(â(X ⪠range(f) ⪠U(A)))"
proof (rule_tac Least_in_Pow_rel_Union, cases "b=0", simp_all)
case True
fix c
assume asm:"x â if_range_F_else_F(F(A), 0, f, c)"
with mem_F_bound
show "câX ⨠c â range(f) ⨠c â U(A)"
unfolding if_range_F_else_F_def if_range_F_def by (cases "cârange(f)") auto
next
case False
fix c
assume "x â if_range_F_else_F(F(A), b, f, c)"
with False mem_F_bound[of x c]
show "câX ⨠c â range(f) ⨠câU(A)"
unfolding if_range_F_else_F_def if_range_F_def by auto
qed
qed
with assms
show ?thesis
using bounded_lam_replacement[of "λx.(μ i. x â if_range_F_else_F(F(A),b,f,i))"
"λX. PowâMâ(â(X ⪠range(f) ⪠U(A)))"] by simp
qed
lemma (in M_basic) lam_Least_assumption_ifM_b0:
fixes F
defines "F ⡠λ_ x. if M(x) then x else 0"
assumes
separations:
"âA'[M]. separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(F(A),0,f,i)â©)"
and
types:"M(A)" "M(f)"
shows "lam_replacement(M,λx . μ i. x â if_range_F_else_F(F(A),0,f,i))"
(is "lam_replacement(M,λx . Least(?P(x)))")
proof -
{
fix x X
assume "M(X)" "xâX" "(μ i. ?P(x,i)) â 0"
moreover from this
obtain m where "Ord(m)" "?P(x,m)"
using Least_0[of "?P(_)"] by auto
moreover
note assms
moreover
have "?P(x,i) â· (M(converse(f) ` i) ⧠i â range(f) ⧠x â converse(f) ` i)" for i
unfolding F_def if_range_F_else_F_def if_range_F_def by auto
ultimately
have "(μ i. ?P(x,i)) â range (f)"
unfolding F_def if_range_F_else_F_def if_range_F_def
by (rule_tac LeastI2) auto
}
with assms
show ?thesis
by (rule_tac bounded_lam_replacement[of _ "λX. range(f) ⪠{0}"]) auto
qed
lemma (in M_replacement_extra) :
fixes F
defines "F ⡠λ_ x. if M(x) then x else 0"
assumes
separations:
"âA'[M]. separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(F(A),b,f,i)â©)"
"separation(M,Ord)"
and
types:"M(A)" "M(f)"
and
"bâ 0"
shows "lam_replacement(M,λx . μ i. x â if_range_F_else_F(F(A),b,f,i))"
(is "lam_replacement(M,λx . Least(?P(x)))")
proof -
have "M(x) â¹(μ i. (M(i) ⶠx â i) ⧠M(i)) = (if Ord(x) then succ(x) else 0)" for x
using Ord_in_Ord
apply (auto intro:Least_0, rule_tac Least_equality, simp_all)
by (frule lt_Ord) (auto dest:le_imp_not_lt[of _ x] intro:ltI[of x])
moreover
have "lam_replacement(M, λx. if Ord(x) then succ(x) else 0)"
using lam_replacement_if[OF _ _ separations(2)] lam_replacement_identity
lam_replacement_constant lam_replacement_hcomp lam_replacement_succ
by simp
moreover
note types â¹bâ 0âº
ultimately
show ?thesis
using lam_replacement_cong
unfolding F_def if_range_F_else_F_def if_range_F_def
by auto
qed
lemma (in M_replacement_extra) :
fixes F r' D
defines "F â¡ drSR_Y(r',D)"
assumes "âA'[M]. separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(F(A),b,f,i)â©)"
"M(A)" "M(b)" "M(f)" "M(r')"
shows "lam_replacement(M,λx . μ i. x â if_range_F_else_F(F(A),b,f,i))"
proof -
from assms(2-)
have [simp]: "M(X) â¹ M(X ⪠range(f) ⪠{domain(x) . x â A})"
"M(r') â¹ M(X) â¹ M({restrict(x,r') . x â A})"
for X r'
using lam_replacement_domain[THEN lam_replacement_imp_strong_replacement,
THEN RepFun_closed, of A]
lam_replacement_restrict'[THEN lam_replacement_imp_strong_replacement,
THEN RepFun_closed, of r' A] by (auto dest:transM)
have "âxâX. (μ i. x â if_range_F_else_F(F(A),b,f,i)) â
PowâMâ(â(X ⪠range(f) ⪠{domain(x). xâA} ⪠{restrict(x,r'). xâA} ⪠domain(A) ⪠range(A) ⪠âA))" if "M(X)" for X
proof
fix x
assume "xâX"
moreover
note â¹M(X)âº
moreover from calculation
have "M(x)" by (auto dest:transM)
moreover
note assms(2-)
ultimately
show "(μ i. x â if_range_F_else_F(F(A),b,f,i)) â
PowâMâ(â(X ⪠range(f) ⪠{domain(x). xâA} ⪠{restrict(x,r'). xâA} ⪠domain(A) ⪠range(A) ⪠âA))"
unfolding if_range_F_else_F_def if_range_F_def
proof (rule_tac Least_in_Pow_rel_Union, simp_all,cases "b=0", simp_all)
case True
fix c
assume asm:"x â (if c â range(f) then F(A, converse(f) ` c) else 0)"
then
show "câX ⨠cârange(f) ⨠(âxâA. c = domain(x)) ⨠(âxâA. c = restrict(x,r')) ⨠c â domain(A) ⨠c â range(A) ⨠(âxâA. câx)" by auto
next
case False
fix c
assume "x â F(A, c)"
then
show "câX ⨠cârange(f) ⨠(âxâA. c = domain(x)) ⨠(âxâA. c = restrict(x,r')) ⨠c â domain(A) ⨠c â range(A) ⨠(âxâA. câx)"
using apply_0
by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
qed
qed
with assms(2-)
show ?thesis
using bounded_lam_replacement[of "λx.(μ i. x â if_range_F_else_F(F(A),b,f,i))"
"λX. PowâMâ(â(X ⪠range(f) ⪠{domain(x). xâA} ⪠{restrict(x,r'). xâA} ⪠domain(A) ⪠range(A) ⪠âA))"] by simp
qed
locale M_replacement_lepoll = M_replacement_extra + M_inj +
fixes F
assumes
F_type[simp]: "M(A) â¹ âx[M]. M(F(A,x))"
and
lam_lepoll_assumption_F:"M(A) â¹ lam_replacement(M,F(A))"
and
lam_Least_assumption:"M(A) â¹ M(b) â¹ M(f) â¹
lam_replacement(M,λx . μ i. x â if_range_F_else_F(F(A),b,f,i))"
and
F_args_closed: "M(A) â¹ M(x) â¹ x â F(A,i) â¹ M(i)"
and
lam_replacement_inj_rel:"lam_replacement(M, λp. injâMâ(fst(p),snd(p)))"
begin
declare if_range_F_else_F_def[simp]
lemma lepoll_assumptions1:
assumes types[simp]:"M(A)" "M(S)"
shows "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r)"
using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
transM[of _ S]
by simp
lemma lepoll_assumptions2:
assumes types[simp]:"M(A)" "M(S)"
shows "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
assms lam_lepoll_assumption_F
by simp
lemma lepoll_assumptions3:
assumes types[simp]:"M(A)"
shows "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r)"
using lam_lepoll_assumption_F[THEN lam_replacement_imp_strong_replacement]
by simp
lemma lepoll_assumptions4:
assumes types[simp]:"M(A)" "M(r)"
shows "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
unfolding lepoll_assumptions_defs
lam_replacement_def[symmetric]
by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
(force intro: lam_replacement_identity)+
lemma lam_Least_closed :
assumes "M(A)" "M(b)" "M(f)"
shows "âx[M]. M(μ i. x â if_range_F_else_F(F(A),b,f,i))"
proof -
have "x â (if i â range(f) then F(A, converse(f) ` i) else 0) â¹ M(i)" for x i
proof (cases "iârange(f)")
case True
with â¹M(f)âº
show ?thesis by (auto dest:transM)
next
case False
moreover
assume "x â (if i â range(f) then F(A, converse(f) ` i) else 0)"
ultimately
show ?thesis
by auto
qed
with assms
show ?thesis
using F_args_closed[of A] unfolding if_range_F_else_F_def if_range_F_def
by (clarify, rule_tac Least_closed', cases "b=0") simp_all
qed
lemma lepoll_assumptions5:
assumes
types[simp]:"M(A)" "M(f)"
shows "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r)"
using
lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
lam_replacement_hcomp[OF _ lam_replacement_apply[of f]]
lam_replacement_identity
lam_replacement_product lam_Least_closed[where b=1]
assms lam_Least_assumption[where b=1,OF â¹M(A)⺠_ â¹M(f)âº]
unfolding lepoll_assumptions_defs
lam_replacement_def[symmetric]
by simp
lemma lepoll_assumptions6:
assumes types[simp]:"M(A)" "M(S)" "M(x)"
shows "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r)"
using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
lam_replacement_inj_rel
by simp
lemma lepoll_assumptions7:
assumes types[simp]:"M(A)" "M(S)" "M(x)"
shows "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_constant lam_lepoll_assumption_F lam_replacement_inj_rel
unfolding lepoll_assumptions_defs
by (rule_tac lam_replacement_imp_strong_replacement)
(rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
lemma lepoll_assumptions8:
assumes types[simp]:"M(A)" "M(S)"
shows "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
lam_replacement_inj_rel lam_replacement_constant
lam_replacement_hcomp2[of _ _ "inj_rel(M)",OF lam_lepoll_assumption_F[of A]]
by simp
lemma lepoll_assumptions9:
assumes types[simp]:"M(A)" "M(S)" "M(r)"
shows "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
lam_replacement_hcomp2[of _ _ "inj_rel(M)"] lam_replacement_inj_rel lepoll_assumptions4
unfolding lepoll_assumptions_defs lam_replacement_def[symmetric]
by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
(force intro: lam_replacement_identity)+
lemma lepoll_assumptions10:
assumes types[simp]:"M(A)" "M(f)"
shows "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
lam_replacement_constant[OF nonempty]
lam_replacement_if[OF _ _ separation_in_constant]
lam_replacement_hcomp
lam_replacement_apply[OF converse_closed[OF â¹M(f)âº]]
lam_lepoll_assumption_F[of A]
by simp
lemma lepoll_assumptions11:
assumes types[simp]:"M(A)" "M(f)"
shows "lepoll_assumptions11(M, A, F, S, fa, K, x, f, r)"
using lam_replacement_imp_strong_replacement
lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]]
lam_replacement_constant
lam_replacement_hcomp lam_replacement_apply
lam_lepoll_assumption_F
by simp
lemma lepoll_assumptions12:
assumes types[simp]:"M(A)" "M(x)" "M(f)"
shows "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r)"
using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
by simp
lemma lepoll_assumptions13:
assumes types[simp]:"M(A)" "M(r)" "M(f)"
shows "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_constant[OF nonempty] lam_lepoll_assumption_F
lam_replacement_hcomp lam_replacement_apply
lam_replacement_hcomp2[OF lam_replacement_constant[OF â¹M(r)âº]
lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]] _ _
lam_replacement_minimum] assms
unfolding lepoll_assumptions_defs
lam_replacement_def[symmetric]
by simp
lemma lepoll_assumptions14:
assumes types[simp]:"M(A)" "M(f)" "M(fa)"
shows "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r)"
using
lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
lam_replacement_hcomp[OF _ lam_replacement_apply[of fa]]
lam_replacement_identity
lam_replacement_product lam_Least_closed[where b=0]
assms lam_Least_assumption[where b=0,OF â¹M(A)⺠_ â¹M(f)âº]
unfolding lepoll_assumptions_defs
lam_replacement_def[symmetric]
by simp
lemma lepoll_assumptions15:
assumes types[simp]:"M(A)" "M(x)" "M(f)" "M(K)"
shows "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r)"
using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
by simp
lemma lepoll_assumptions16:
assumes types[simp]:"M(A)" "M(f)" "M(K)"
shows "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_imp_strong_replacement
lam_replacement_inj_rel lam_replacement_constant
lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
lam_replacement_constant[OF nonempty]
lam_replacement_if[OF _ _ separation_in_constant]
lam_replacement_hcomp
lam_replacement_apply[OF converse_closed[OF â¹M(f)âº]]
lam_lepoll_assumption_F[of A]
by simp
lemma lepoll_assumptions17:
assumes types[simp]:"M(A)" "M(f)" "M(K)"
shows "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
lam_replacement_inj_rel lam_replacement_constant
lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
lam_replacement_constant[OF nonempty]
lam_replacement_if[OF _ _ separation_in_constant]
lam_replacement_hcomp
lam_replacement_apply[OF converse_closed[OF â¹M(f)âº]]
lam_lepoll_assumption_F[of A]
by simp
lemma lepoll_assumptions18:
assumes types[simp]:"M(A)" "M(K)" "M(f)" "M(r)"
shows "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r)"
using lam_replacement_constant lam_replacement_inj_rel lam_lepoll_assumption_F
lam_replacement_minimum lam_replacement_identity lam_replacement_apply2 separation_in_constant
unfolding lepoll_assumptions18_def lam_replacement_def[symmetric]
by (rule_tac lam_replacement_hcomp2[of _ _ minimum], simp_all,
rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
(rule_tac lam_replacement_if, rule_tac lam_replacement_hcomp[of _ "F(A)"],
rule_tac lam_replacement_hcomp2[of _ _ "(`)"], simp_all)
lemmas lepoll_assumptions = lepoll_assumptions1 lepoll_assumptions2
lepoll_assumptions3 lepoll_assumptions4 lepoll_assumptions5
lepoll_assumptions6 lepoll_assumptions7 lepoll_assumptions8
lepoll_assumptions9 lepoll_assumptions10 lepoll_assumptions11
lepoll_assumptions12 lepoll_assumptions13 lepoll_assumptions14
lepoll_assumptions15 lepoll_assumptions16
lepoll_assumptions17 lepoll_assumptions18
end
end
Theory Cardinal_Library_Relative
sectionâ¹Cardinal Arithmetic under Choice\label{sec:cardinal-lib-rel}âº
theory Cardinal_Library_Relative
imports
Replacement_Lepoll
begin
locale M_library = M_ZF_library + M_cardinal_AC +
assumes
separation_cardinal_rel_lesspoll_rel: "M(κ) â¹ separation(M, λx . x âºâMâ κ)"
begin
declare eqpoll_rel_refl [simp]
subsectionâ¹Miscellaneousâº
lemma cardinal_rel_RepFun_apply_le:
assumes "S â AâB" "M(S)" "M(A)" "M(B)"
shows "|{S`a . aâA}|âMâ ⤠|A|âMâ"
proof -
note assms
moreover from this
have "{S ` a . a â A} = S``A"
using image_eq_UN RepFun_def UN_iff by force
moreover from calculation
have "M(λxâA. S ` x)" "M({S ` a . a â A})"
using lam_closed[of "λ x. S`x"] apply_type[OF â¹Sâ_âº]
transM[OF _ â¹M(B)âº] image_closed
by auto
moreover from assms this
have "(λxâA. S`x) â surj_rel(M,A, {S`a . aâA})"
using mem_surj_abs lam_funtype[of A "λx . S`x"]
unfolding surj_def by auto
ultimately
show ?thesis
using surj_rel_char surj_rel_implies_cardinal_rel_le by simp
qed
lemma cardinal_rel_RepFun_le:
assumes lrf:"lam_replacement(M,f)" and f_closed:"âx[M]. M(f(x))" and "M(X)"
shows "|{f(x) . x â X}|âMâ ⤠|X|âMâ"
using â¹M(X)⺠f_closed cardinal_rel_RepFun_apply_le[OF lam_funtype, of X _, OF
lrf[THEN [2] lam_replacement_iff_lam_closed[THEN iffD1, THEN rspec]]]
lrf[THEN lam_replacement_imp_strong_replacement]
by simp (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
lemma subset_imp_le_cardinal_rel: "A â B â¹ M(A) â¹ M(B) â¹ |A|âMâ ⤠|B|âMâ"
using subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le] .
lemma lt_cardinal_rel_imp_not_subset: "|A|âMâ < |B|âMâ â¹ M(A) â¹ M(B) ⹠¬ B â A"
using subset_imp_le_cardinal_rel le_imp_not_lt by blast
lemma cardinal_rel_lt_csucc_rel_iff:
"Card_rel(M,K) â¹ M(K) â¹ M(K') â¹ |K'|âMâ < (Kâ§+)âMâ â· |K'|âMâ ⤠K"
by (simp add: Card_rel_lt_csucc_rel_iff)
end
locale M_cardinal_UN_nat = M_cardinal_UN _ Ï X for X
begin
lemma cardinal_rel_UN_le_nat:
assumes "âi. iâÏ â¹ |X(i)|âMâ ⤠Ï"
shows "|âiâÏ. X(i)|âMâ ⤠Ï"
proof -
from assms
show ?thesis
by (simp add: cardinal_rel_UN_le InfCard_rel_nat)
qed
end
locale M_cardinal_UN_inj = M_library +
j:M_cardinal_UN _ J +
y:M_cardinal_UN _ K "λk. if kârange(f) then X(converse(f)`k) else 0" for J K f +
assumes
f_inj: "f â inj_rel(M,J,K)"
begin
lemma inj_rel_imp_cardinal_rel_UN_le:
notes [dest] = InfCard_is_Card Card_is_Ord
fixes Y
defines "Y(k) â¡ if kârange(f) then X(converse(f)`k) else 0"
assumes "InfCardâMâ(K)" "âi. iâJ â¹ |X(i)|âMâ ⤠K"
shows "|âiâJ. X(i)|âMâ ⤠K"
proof -
have "M(K)" "M(J)" "âw x. w â X(x) â¹ M(x)"
using y.Pi_assumptions j.Pi_assumptions j.X_witness_in_M by simp_all
then
have "M(f)"
using inj_rel_char f_inj by simp
note inM = â¹M(f)⺠â¹M(K)⺠â¹M(J)⺠â¹âw x. w â X(x) â¹ M(x)âº
have "iâJ â¹ f`i â K" for i
using inj_rel_is_fun[OF f_inj] apply_type
function_space_rel_char by (auto simp add:inM)
have "(âiâJ. X(i)) â (âiâK. Y(i))"
proof (standard, elim UN_E)
fix x i
assume "iâJ" "xâX(i)"
with â¹iâJ â¹ f`i â Kâº
have "x â Y(f`i)" "f`i â K"
unfolding Y_def
using inj_is_fun right_inverse f_inj
by (auto simp add:inM Y_def intro: apply_rangeI)
then
show "x â (âiâK. Y(i))" by auto
qed
then
have "|âiâJ. X(i)|âMâ ⤠|âiâK. Y(i)|âMâ"
using subset_imp_le_cardinal_rel j.UN_closed y.UN_closed
unfolding Y_def by (simp add:inM)
moreover
note assms â¹âi. iâJ â¹ f`i â K⺠inM
moreover from this
have "kârange(f) â¹ converse(f)`k â J" for k
using inj_rel_converse_fun[OF f_inj]
range_fun_subset_codomain function_space_rel_char by simp
ultimately
show "|âiâJ. X(i)|âMâ ⤠K"
using InfCard_rel_is_Card_rel[THEN Card_rel_is_Ord,THEN Ord_0_le, of K]
by (rule_tac le_trans[OF _ y.cardinal_rel_UN_le])
(auto intro:Ord_0_le simp:Y_def)+
qed
end
locale M_cardinal_UN_lepoll = M_library + M_replacement_lepoll _ "λ_. X" +
j:M_cardinal_UN _ J for J
begin
lemma leqpoll_rel_imp_cardinal_rel_UN_le:
notes [dest] = InfCard_is_Card Card_is_Ord
assumes "InfCardâMâ(K)" "J â²âMâ K" "âi. iâJ â¹ |X(i)|âMâ ⤠K"
"M(K)"
shows "|âiâJ. X(i)|âMâ ⤠K"
proof -
from â¹J â²âMâ Kâº
obtain f where "f â inj_rel(M,J,K)" "M(f)" by blast
moreover
let ?Y="λk. if kârange(f) then X(converse(f)`k) else 0"
note â¹M(K)âº
moreover from calculation
have "k â range(f) â¹ converse(f)`k â J" for k
using mem_inj_rel[THEN inj_converse_fun, THEN apply_type]
j.Pi_assumptions by blast
moreover from â¹M(f)âº
have "w â ?Y(x) â¹ M(x)" for w x
by (cases "xârange(f)") (auto dest:transM)
moreover from calculation
interpret M_Pi_assumptions_choice _ K ?Y
using j.Pi_assumptions lepoll_assumptions
proof (unfold_locales, auto dest:transM)
show "strong_replacement(M, λy z. False)"
unfolding strong_replacement_def by auto
qed
from calculation
interpret M_cardinal_UN_inj _ _ _ _ f
using lepoll_assumptions
by unfold_locales auto
from assms
show ?thesis using inj_rel_imp_cardinal_rel_UN_le by simp
qed
end
context M_library
begin
lemma cardinal_rel_lt_csucc_rel_iff':
includes Ord_dests
assumes "Card_rel(M,κ)"
and types:"M(κ)" "M(X)"
shows "κ < |X|âMâ â· (κâ§+)âMâ ⤠|X|âMâ"
using assms cardinal_rel_lt_csucc_rel_iff[of κ X] Card_rel_csucc_rel[of κ]
not_le_iff_lt[of "(κâ§+)âMâ" "|X|âMâ"] not_le_iff_lt[of "|X|âMâ" κ]
by blast
lemma lepoll_rel_imp_subset_bij_rel:
assumes "M(X)" "M(Y)"
shows "X â²âMâ Y â· (âZ[M]. Z â Y ⧠Z ââMâ X)"
proof
assume "X â²âMâ Y"
then
obtain j where "j â inj_rel(M,X,Y)"
by blast
with assms
have "range(j) â Y" "j â bij_rel(M,X,range(j))" "M(range(j))" "M(j)"
using inj_rel_bij_rel_range inj_rel_char
inj_rel_is_fun[THEN range_fun_subset_codomain,of j X Y]
by auto
with assms
have "range(j) â Y" "X ââMâ range(j)"
unfolding eqpoll_rel_def by auto
with assms â¹M(j)âº
show "âZ[M]. Z â Y ⧠Z ââMâ X"
using eqpoll_rel_sym[OF â¹X ââMâ range(j)âº]
by auto
next
assume "âZ[M]. Z â Y ⧠Z ââMâ X"
then
obtain Z f where "f â bij_rel(M,Z,X)" "Z â Y" "M(Z)" "M(f)"
unfolding eqpoll_rel_def by blast
with assms
have "converse(f) â inj_rel(M,X,Y)" "M(converse(f))"
using inj_rel_weaken_type[OF bij_rel_converse_bij_rel[THEN bij_rel_is_inj_rel],of f Z X Y]
by auto
then
show "X â²âMâ Y"
unfolding lepoll_rel_def by auto
qed
textâ¹The following result proves to be very useful when combining
\<^term>â¹cardinal_rel⺠and \<^term>â¹eqpoll_rel⺠in a calculation.âº
lemma cardinal_rel_Card_rel_eqpoll_rel_iff:
"Card_rel(M,κ) â¹ M(κ) â¹ M(X) â¹ |X|âMâ = κ â· X ââMâ κ"
using Card_rel_cardinal_rel_eq[of κ] cardinal_rel_eqpoll_rel_iff[of X κ] by auto
lemma lepoll_rel_imp_lepoll_rel_cardinal_rel:
assumes"X â²âMâ Y" "M(X)" "M(Y)"
shows "X â²âMâ |Y|âMâ"
using assms cardinal_rel_Card_rel_eqpoll_rel_iff[of "|Y|âMâ" Y]
Card_rel_cardinal_rel
lepoll_rel_eq_trans[of _ _ "|Y|âMâ"] by simp
lemma lepoll_rel_Un:
assumes "InfCard_rel(M,κ)" "A â²âMâ κ" "B â²âMâ κ" "M(A)" "M(B)" "M(κ)"
shows "A ⪠B â²âMâ κ"
proof -
from assms
have "A ⪠B â²âMâ sum(A,B)"
using Un_lepoll_rel_sum by simp
moreover
note assms
moreover from this
have "|sum(A,B)|âMâ ⤠κ ââMâ κ"
using sum_lepoll_rel_mono[of A κ B κ] lepoll_rel_imp_cardinal_rel_le
unfolding cadd_rel_def by auto
ultimately
show ?thesis
using InfCard_rel_cdouble_eq Card_rel_cardinal_rel_eq
InfCard_rel_is_Card_rel Card_rel_le_imp_lepoll_rel[of "sum(A,B)" κ]
lepoll_rel_trans[of "AâªB"]
by auto
qed
lemma cardinal_rel_Un_le:
assumes "InfCard_rel(M,κ)" "|A|âMâ ⤠κ" "|B|âMâ ⤠κ" "M(κ)" "M(A)" "M(B)"
shows "|A ⪠B|âMâ ⤠κ"
using assms lepoll_rel_Un le_Card_rel_iff InfCard_rel_is_Card_rel by auto
lemma Finite_cardinal_rel_iff': "M(i) â¹ Finite(|i|âMâ) â· Finite(i)"
using eqpoll_rel_imp_Finite_iff[OF cardinal_rel_eqpoll_rel]
by auto
lemma cardinal_rel_subset_of_Card_rel:
assumes "Card_rel(M,γ)" "a â γ" "M(a)" "M(γ)"
shows "|a|âMâ < γ ⨠|a|âMâ = γ"
proof -
from assms
have "|a|âMâ < |γ|âMâ ⨠|a|âMâ = |γ|âMâ"
using subset_imp_le_cardinal_rel[THEN le_iff[THEN iffD1]] by simp
with assms
show ?thesis
using Card_rel_cardinal_rel_eq by auto
qed
lemma cardinal_rel_cases:
includes Ord_dests
assumes "M(γ)" "M(X)"
shows "Card_rel(M,γ) â¹ |X|âMâ < γ ⷠ¬ |X|âMâ ⥠γ"
using assms not_le_iff_lt Card_rel_is_Ord Ord_cardinal_rel
by auto
end
subsectionâ¹Countable and uncountable setsâº
definition
countable :: "iâo" where
"countable(X) â¡ X â² Ï"
relativize functional "countable" "countable_rel" external
relationalize "countable_rel" "is_countable"
notation countable_rel (â¹countableâ_â'(_')âº)
abbreviation
countable_r_set :: "[i,i]âo" (â¹countableâ_â'(_')âº) where
"countableâMâ(i) â¡ countable_rel(##M,i)"
context M_library
begin
lemma countableI[intro]: "X â²âMâ Ï â¹ countable_rel(M,X)"
unfolding countable_rel_def by simp
lemma countableD[dest]: "countable_rel(M,X) â¹ X â²âMâ Ï"
unfolding countable_rel_def by simp
lemma countable_rel_iff_cardinal_rel_le_nat: "M(X) â¹ countable_rel(M,X) â· |X|âMâ ⤠Ï"
using le_Card_rel_iff[of Ï X] Card_rel_nat
unfolding countable_rel_def by simp
lemma lepoll_rel_countable_rel: "X â²âMâ Y â¹ countable_rel(M,Y) â¹ M(X) â¹ M(Y) â¹ countable_rel(M,X)"
using lepoll_rel_trans[of X Y] by blast
lemma surj_rel_countable_rel:
"countable_rel(M,X) â¹ f â surj_rel(M,X,Y) â¹ M(X) â¹ M(Y) â¹ M(f) â¹ countable_rel(M,Y)"
using surj_rel_implies_cardinal_rel_le[of f X Y, THEN le_trans]
countable_rel_iff_cardinal_rel_le_nat by simp
lemma Finite_imp_countable_rel: "Finite_rel(M,X) â¹ M(X) â¹ countable_rel(M,X)"
unfolding Finite_rel_def
by (auto intro:InfCard_rel_nat nats_le_InfCard_rel[of _ Ï,
THEN le_imp_lepoll_rel] dest!:eq_lepoll_rel_trans[of X _ Ï] )
end
lemma (in M_cardinal_UN_lepoll) countable_rel_imp_countable_rel_UN:
assumes "countable_rel(M,J)" "âi. iâJ â¹ countable_rel(M,X(i))"
shows "countable_rel(M,âiâJ. X(i))"
using assms leqpoll_rel_imp_cardinal_rel_UN_le[of Ï] InfCard_rel_nat
InfCard_rel_is_Card_rel j.UN_closed
countable_rel_iff_cardinal_rel_le_nat j.Pi_assumptions
Card_rel_le_imp_lepoll_rel[of J Ï] Card_rel_cardinal_rel_eq[of Ï]
by auto
locale M_cardinal_library = M_library + M_replacement +
assumes
lam_replacement_inj_rel:"lam_replacement(M, λx. injâMâ(fst(x),snd(x)))"
and
cdlt_assms: "M(G) â¹ M(Q) â¹ separation(M, λp. âxâG. x â snd(p) â· (âsâfst(p). â¨s, xâ© â Q))"
and
cardinal_lib_assms1:
"M(A) â¹ M(b) â¹ M(f) â¹
separation(M, λy. âxâA. y = â¨x, μ i. x â if_range_F_else_F(λx. if M(x) then x else 0,b,f,i)â©)"
and
cardinal_lib_assms2:
"M(A') â¹ M(G) â¹ M(b) â¹ M(f) â¹
separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(λa. if M(a) then G`a else 0,b,f,i)â©)"
and
cardinal_lib_assms3:
"M(A') â¹ M(b) â¹ M(f) â¹ M(F) â¹
separation(M, λy. âxâA'. y = â¨x, μ i. x â if_range_F_else_F(λa. if M(a) then F-``{a} else 0,b,f,i)â©)"
and
lam_replacement_cardinal_rel : "lam_replacement(M, cardinal_rel(M))"
and
cardinal_lib_assms6:
"M(f) â¹ M(β) â¹ Ord(β) â¹
strong_replacement(M, λx y. xâβ ⧠y = â¨x, transrec(x, λa g. f ` (g `` a))â©)"
begin
lemma cardinal_lib_assms5 :
"M(γ) ⹠Ord(γ) ⹠separation(M, λZ . cardinal_rel(M,Z) < γ)"
unfolding lt_def
using separation_in lam_replacement_constant[of γ] separation_univ lam_replacement_cardinal_rel
unfolding lt_def
by simp_all
lemma separation_dist: "separation(M, λ x . âa. âb . x=â¨a,b⩠⧠aâ b)"
using separation_pair separation_neg separation_eq lam_replacement_fst lam_replacement_snd
by simp
lemma cdlt_assms': "M(x) â¹ M(Q) â¹ separation(M, λa . âsâx. â¨s, aâ© â Q)"
using separation_in[OF _
lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] _
lam_replacement_constant]
separation_ball lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
by simp_all
lemma countable_rel_union_countable_rel:
assumes "âx. x â C â¹ countable_rel(M,x)" "countable_rel(M,C)" "M(C)"
shows "countable_rel(M,âC)"
proof -
have "x â (if M(i) then i else 0) â¹ M(i)" for x i
by (cases "M(i)") auto
then
interpret M_replacement_lepoll M "λ_ x. if M(x) then x else 0"
using lam_replacement_if[OF lam_replacement_identity
lam_replacement_constant[OF nonempty], where b=M] lam_replacement_inj_rel
proof(unfold_locales,auto simp add: separation_def)
fix b f
assume "M(b)" "M(f)"
show "lam_replacement(M, λx. μ i. x â if_range_F_else_F(λx. if M(x) then x else 0, b, f, i))"
proof (cases "b=0")
case True
with â¹M(f)âº
show ?thesis
using cardinal_lib_assms1
by (simp_all; rule_tac lam_Least_assumption_ifM_b0)+
next
case False
with â¹M(f)⺠â¹M(b)âº
show ?thesis
using cardinal_lib_assms1 separation_Ord
by (rule_tac lam_Least_assumption_ifM_bnot0) auto
qed
qed
note â¹M(C)âº
moreover
have "w â (if M(x) then x else 0) â¹ M(x)" for w x
by (cases "M(x)") auto
ultimately
interpret M_cardinal_UN_lepoll _ "λc. if M(c) then c else 0" C
using lepoll_assumptions
by unfold_locales simp_all
have "(if M(i) then i else 0) = i" if "iâC" for i
using transM[OF _ â¹M(C)âº] that by simp
then
show ?thesis
using assms countable_rel_imp_countable_rel_UN by simp
qed
end
abbreviation
uncountable_rel :: "[iâo,i]âo" where
"uncountable_rel(M,X) ⡠¬ countable_rel(M,X)"
context M_cardinal_library
begin
lemma uncountable_rel_iff_nat_lt_cardinal_rel:
"M(X) â¹ uncountable_rel(M,X) â· Ï < |X|âMâ"
using countable_rel_iff_cardinal_rel_le_nat not_le_iff_lt by simp
lemma uncountable_rel_not_empty: "uncountable_rel(M,X) â¹ X â 0"
using empty_lepoll_relI by auto
lemma uncountable_rel_imp_Infinite: "uncountable_rel(M,X) â¹ M(X) â¹ Infinite(X)"
using uncountable_rel_iff_nat_lt_cardinal_rel[of X] lepoll_rel_nat_imp_Infinite[of X]
cardinal_rel_le_imp_lepoll_rel[of Ï X] leI
by simp
lemma uncountable_rel_not_subset_countable_rel:
assumes "countable_rel(M,X)" "uncountable_rel(M,Y)" "M(X)" "M(Y)"
shows "¬ (Y â X)"
using assms lepoll_rel_trans subset_imp_lepoll_rel[of Y X]
by blast
subsectionâ¹Results on Aleph\_relsâº
lemma nat_lt_Aleph_rel1: "Ï < âµâ1ââMâ"
by (simp add: Aleph_rel_succ Aleph_rel_zero lt_csucc_rel)
lemma zero_lt_Aleph_rel1: "0 < âµâ1ââMâ"
by (rule lt_trans[of _ "Ï"], auto simp add: ltI nat_lt_Aleph_rel1)
lemma le_Aleph_rel1_nat: "M(k) â¹ Card_rel(M,k) â¹ k<âµâ1ââMâ â¹ k ⤠Ï"
by (simp add: Aleph_rel_succ Aleph_rel_zero Card_rel_lt_csucc_rel_iff Card_rel_nat)
lemma lesspoll_rel_Aleph_rel_succ:
assumes "Ord(α)"
and types:"M(α)" "M(d)"
shows "d âºâMâ âµâsucc(α)ââMâ â· d â²âMâ âµâαââMâ"
using assms Aleph_rel_succ Card_rel_is_Ord Ord_Aleph_rel lesspoll_rel_csucc_rel
by simp
lemma cardinal_rel_Aleph_rel [simp]: "Ord(α) â¹ M(α) â¹ |âµâαââMâ|âMâ = âµâαââMâ"
using Card_rel_cardinal_rel_eq by simp
lemma Aleph_rel_lesspoll_rel_increasing:
includes Aleph_rel_intros
assumes "M(b)" "M(a)"
shows "a < b â¹ âµâaââMâ âºâMâ âµâbââMâ"
using assms
cardinal_rel_lt_iff_lesspoll_rel[of "âµâaââMâ" "âµâbââMâ"]
Aleph_rel_increasing[of a b] Card_rel_cardinal_rel_eq[of "âµâbâ"]
lt_Ord lt_Ord2 Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
by auto
lemma uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1:
includes Ord_dests
assumes "M(X)"
notes Aleph_rel_zero[simp] Card_rel_nat[simp] Aleph_rel_succ[simp]
shows "uncountable_rel(M,X) â· (âS[M]. S â X ⧠S ââMâ âµâ1ââMâ)"
proof
assume "uncountable_rel(M,X)"
with â¹M(X)âº
have "âµâ1ââMâ â²âMâ X"
using uncountable_rel_iff_nat_lt_cardinal_rel cardinal_rel_lt_csucc_rel_iff'
cardinal_rel_le_imp_lepoll_rel by auto
with â¹M(X)âº
obtain S where "M(S)" "S â X" "S ââMâ âµâ1ââMâ"
using lepoll_rel_imp_subset_bij_rel by auto
then
show "âS[M]. S â X ⧠S ââMâ âµâ1ââMâ"
using cardinal_rel_cong Card_rel_csucc_rel[of Ï] Card_rel_cardinal_rel_eq by auto
next
note Aleph_rel_lesspoll_rel_increasing[of 1 0,simplified]
assume "âS[M]. S â X ⧠S ââMâ âµâ1ââMâ"
moreover
have eq:"âµâ1ââMâ = (Ïâ§+)âMâ" by auto
moreover from calculation â¹M(X)âº
have A:"(Ïâ§+)âMâ â²âMâ X"
using subset_imp_lepoll_rel[THEN [2] eq_lepoll_rel_trans, of "âµâ1ââMâ" _ X,
OF eqpoll_rel_sym] by auto
with â¹M(X)âº
show "uncountable_rel(M,X)"
using
lesspoll_rel_trans1[OF lepoll_rel_trans[OF A _] â¹Ï âºâMâ (Ïâ§+)âMââº]
lesspoll_rel_not_refl
by auto
qed
lemma UN_if_zero: "M(K) â¹ (âxâK. if M(x) then G ` x else 0) =(âxâK. G ` x)"
using transM[of _ K] by auto
lemma mem_F_bound1:
fixes F G
defines "F ⡠λ_ x. if M(x) then G`x else 0"
shows "xâF(A,c) â¹ c â (range(f) ⪠domain(G) )"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
lemma lt_Aleph_rel_imp_cardinal_rel_UN_le_nat: "function(G) â¹ domain(G) â²âMâ Ï â¹
ânâdomain(G). |G`n|âMâ<âµâ1ââMâ â¹ M(G) â¹ |ânâdomain(G). G`n|âMââ¤Ï"
proof -
assume "M(G)"
moreover from this
have "x â (if M(i) then G ` i else 0) â¹ M(i)" for x i
by (cases "M(i)") auto
moreover
have "separation(M, M)" unfolding separation_def by auto
ultimately
interpret M_replacement_lepoll M "λ_ x. if M(x) then G`x else 0"
using lam_replacement_inj_rel cardinal_lib_assms2 mem_F_bound1[of _ _ G]
lam_if_then_replacement_apply
by (unfold_locales, simp_all)
(rule lam_Least_assumption_general[where U="λ_. domain(G)"], auto)
note â¹M(G)âº
moreover
have "w â (if M(x) then G ` x else 0) â¹ M(x)" for w x
by (cases "M(x)") auto
ultimately
interpret M_cardinal_UN_lepoll _ "λn. if M(n) then G`n else 0" "domain(G)"
using lepoll_assumptions1[where S="domain(G)",unfolded lepoll_assumptions1_def]
cardinal_lib_assms2 lepoll_assumptions
by (unfold_locales, auto)
assume "function(G)"
let ?N="domain(G)" and ?R="ânâdomain(G). G`n"
assume "?N â²âMâ Ï"
assume Eq1: "ânâ?N. |G`n|âMâ<âµâ1ââMâ"
{
fix n
assume "nâ?N"
with Eq1 â¹M(G)âº
have "|G`n|âMâ ⤠Ï"
using le_Aleph_rel1_nat[of "|G ` n|âMâ"] leqpoll_rel_imp_cardinal_rel_UN_le
UN_if_zero[of "domain(G)" G]
by (auto dest:transM)
}
then
have "nâ?N â¹ |G`n|âMâ ⤠Ï" for n .
moreover
note â¹?N â²âMâ Ï⺠â¹M(G)âº
moreover
have "(if M(i) then G ` i else 0) â G ` i" for i
by auto
with â¹M(G)âº
have "|if M(i) then G ` i else 0|âMâ ⤠|G ` i|âMâ" for i
proof(cases "M(i)")
case True
with â¹M(G)⺠show ?thesis using Ord_cardinal_rel[OF apply_closed]
by simp
next
case False
then
have "iâdomain(G)"
using transM[OF _ domain_closed[OF â¹M(G)âº]] by auto
then
show ?thesis
using Ord_cardinal_rel[OF apply_closed] apply_0 by simp
qed
ultimately
show ?thesis
using InfCard_rel_nat leqpoll_rel_imp_cardinal_rel_UN_le[of Ï]
UN_if_zero[of "domain(G)" G]
le_trans[of "|if M(_) then G ` _ else 0|âMâ" "|G ` _|âMâ" Ï]
by auto blast
qed
lemma Aleph_rel1_eq_cardinal_rel_vimage: "f:âµâ1ââMâââMâÏ â¹ ânâÏ. |f-``{n}|âMâ = âµâ1ââMâ"
proof -
assume "f:âµâ1ââMâââMâÏ"
then
have "function(f)" "domain(f) = âµâ1ââMâ" "range(f)âÏ" "fââµâ1ââMââÏ" "M(f)"
using mem_function_space_rel[OF â¹fâ_âº] domain_of_fun fun_is_function range_fun_subset_codomain
function_space_rel_char
by auto
let ?G="λnârange(f). f-``{n}"
from â¹f:âµâ1ââMââÏâº
have "range(f) â Ï" "domain(?G) = range(f)"
using range_fun_subset_codomain
by simp_all
from â¹f:âµâ1ââMââÏ⺠â¹M(f)⺠â¹range(f) â Ïâº
have "M(f-``{n})" if "n â range(f)" for n
using that transM[of _ Ï] by auto
with â¹M(f)⺠â¹range(f) â Ïâº
have "domain(?G) â²âMâ Ï" "M(?G)"
using subset_imp_lepoll_rel lam_closed[of "λx . f-``{x}"] cardinal_lib_assms4
by simp_all
have "function(?G)" by (simp add:function_lam)
from â¹f:âµâ1ââMââÏâº
have "nâÏ â¹ f-``{n} â âµâ1ââMâ" for n
using Pi_vimage_subset by simp
with â¹range(f) â Ïâº
have "âµâ1ââMâ = (ânârange(f). f-``{n})"
proof (intro equalityI, intro subsetI)
fix x
assume "x â âµâ1ââMâ"
with â¹f:âµâ1ââMââÏ⺠â¹function(f)⺠â¹domain(f) = âµâ1ââMââº
have "x â f-``{f`x}" "f`x â range(f)"
using function_apply_Pair vimage_iff apply_rangeI by simp_all
then
show "x â (ânârange(f). f-``{n})" by auto
qed auto
{
assume "ânârange(f). |f-``{n}|âMâ < âµâ1ââMâ"
then
have "ânâdomain(?G). |?G`n|âMâ < âµâ1ââMâ"
using zero_lt_Aleph_rel1 by (auto)
with â¹function(?G)⺠â¹domain(?G) â²âMâ Ï⺠â¹M(?G)âº
have "|ânâdomain(?G). ?G`n|âMââ¤Ï"
using lt_Aleph_rel_imp_cardinal_rel_UN_le_nat[of ?G]
by auto
then
have "|ânârange(f). f-``{n}|âMââ¤Ï" by simp
with â¹âµâ1ââMâ = _âº
have "|âµâ1ââMâ|âMâ ⤠Ï" by auto
then
have "âµâ1ââMâ ⤠Ï"
using Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
by auto
then
have "False"
using nat_lt_Aleph_rel1 by (blast dest:lt_trans2)
}
with â¹range(f)âÏ⺠â¹M(f)âº
obtain n where "nâÏ" "¬(|f -`` {n}|âMâ < âµâ1ââMâ)" "M(f -`` {n})"
using nat_into_M by auto
moreover from this
have "âµâ1ââMâ ⤠|f-``{n}|âMâ"
using not_lt_iff_le Card_rel_is_Ord by simp
moreover
note â¹nâÏ â¹ f-``{n} â âµâ1ââMââº
ultimately
show ?thesis
using subset_imp_le_cardinal_rel[THEN le_anti_sym, of _ "âµâ1ââMâ"]
Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
by auto
qed
lemma eqpoll_rel_Aleph_rel1_cardinal_rel_vimage:
assumes "Z ââMâ (âµâ1ââMâ)" "f â Z ââMâ Ï" "M(Z)"
shows "ânâÏ. |f-``{n}|âMâ = âµâ1ââMâ"
proof -
have "M(1)" "M(Ï)" by simp_all
then
have "M(âµâ1ââMâ)" by simp
with assms â¹M(1)âº
obtain g where A:"gâbij_rel(M,âµâ1ââMâ,Z)" "M(g)"
using eqpoll_rel_sym unfolding eqpoll_rel_def by blast
with â¹f : Z ââMâ Ï⺠assms
have "M(f)" "converse(g) â bij_rel(M,Z, âµâ1ââMâ)" "fâZâÏ" "gâ âµâ1ââMââZ"
using bij_rel_is_fun_rel bij_rel_converse_bij_rel bij_rel_char function_space_rel_char
by simp_all
with â¹gâbij_rel(M,âµâ1ââMâ,Z)⺠â¹M(g)âº
have "f O g : âµâ1ââMâ ââMâ Ï" "M(converse(g))"
using comp_fun[OF _ â¹fâ Zâ_âº,of g] function_space_rel_char
by simp_all
then
obtain n where "nâÏ" "|(f O g)-``{n}|âMâ = âµâ1ââMâ"
using Aleph_rel1_eq_cardinal_rel_vimage
by auto
with â¹M(f)⺠â¹M(converse(g))âº
have "M(converse(g) `` (f -`` {n}))" "f -`` {n} â Z"
using image_comp converse_comp Pi_iff[THEN iffD1,OF â¹fâZâÏâº] vimage_subset
unfolding vimage_def
using transM[OF â¹nâÏâº]
by auto
from â¹nâÏ⺠â¹|(f O g)-``{n}|âMâ = âµâ1ââMââº
have "âµâ1ââMâ = |converse(g) `` (f -``{n})|âMâ"
using image_comp converse_comp unfolding vimage_def
by auto
also from â¹converse(g) â bij_rel(M,Z, âµâ1ââMâ)⺠â¹f: ZââMâ Ï⺠â¹M(Z)⺠â¹M(f)⺠â¹M(âµâ1ââMâ)âº
â¹M(converse(g) `` (f -`` {n}))âº
have "⦠= |f -``{n}|âMâ"
using range_of_subset_eqpoll_rel[of "converse(g)" Z _ "f -``{n}",
OF bij_rel_is_inj_rel[OF â¹converse(g)â_âº] â¹f -`` {n} â Zâº]
cardinal_rel_cong vimage_closed[OF singleton_closed[OF transM[OF â¹nâÏâº]],of f]
by auto
finally
show ?thesis using â¹nâ_⺠by auto
qed
subsectionâ¹Applications of transfinite recursive constructionsâº
definition
rec_constr :: "[i,i] â i" where
"rec_constr(f,α) ⡠transrec(α,λa g. f`(g``a))"
textâ¹The function \<^term>â¹rec_constr⺠allows to perform ââ¹recursive
constructionsâº: given a choice function on the powerset of some
set, a transfinite sequence is created by successively choosing
some new element.
The next result explains its use.âº
lemma rec_constr_unfold: "rec_constr(f,α) = f`({rec_constr(f,β). βâα})"
using def_transrec[OF rec_constr_def, of f α] image_lam by simp
lemma rec_constr_type:
assumes "f:Pow_rel(M,G)ââMâ G" "Ord(α)" "M(G)"
shows "M(α) â¹ rec_constr(f,α) â G"
using assms(2)
proof(induct rule:trans_induct)
case (step β)
with assms
have "{rec_constr(f, x) . x â β} = {y . x â β, y=rec_constr(f, x)}" (is "_ = ?Y")
"M(f)"
using transM[OF _ â¹M(β)âº] function_space_rel_char Ord_in_Ord
by auto
moreover from assms this step â¹M(β)⺠â¹Ord(β)âº
have "M({y . x â β, y=<x,rec_constr(f, x)>})" (is "M(?Z)")
using strong_replacement_closed[OF cardinal_lib_assms6(1),of f β β,OF _ _ _ _
univalent_conjI2[where P="λx _ . xâβ",OF univalent_triv]]
transM[OF _ â¹M(β)âº] transM[OF step(2) â¹M(G)âº] Ord_in_Ord
unfolding rec_constr_def
by auto
moreover from assms this step â¹M(β)⺠â¹Ord(β)âº
have "?Y = {snd(y) . yâ?Z}"
proof(intro equalityI, auto)
fix u
assume "uâβ"
with assms this step â¹M(β)⺠â¹Ord(β)âº
have "<u,rec_constr(f,u)> â ?Z" "rec_constr(f, u) = snd(<u,rec_constr(f,u)>)"
by auto
then
show "âxâ{y . x â β, y = â¨x, rec_constr(f, x)â©}. rec_constr(f, u) = snd(x)"
using bexI[of _ u] by force
qed
moreover from â¹M(?Z)⺠â¹?Y = _âº
have "M(?Y)"
using
RepFun_closed[OF lam_replacement_imp_strong_replacement[OF lam_replacement_snd] â¹M(?Z)âº]
fst_snd_closed[THEN conjunct2] transM[OF _ â¹M(?Z)âº]
by simp
moreover from assms step
have "{rec_constr(f, x) . x â β} â Pow(G)" (is "?Xâ_")
using transM[OF _ â¹M(β)âº] function_space_rel_char
by auto
moreover from assms calculation step
have "M(?X)"
by simp
moreover from calculation â¹M(G)âº
have "?XâPow_rel(M,G)"
using Pow_rel_char by simp
ultimately
have "f`?X â G"
using assms apply_type[OF mem_function_space_rel[of f],of "Pow_rel(M,G)" G ?X]
by auto
then
show ?case
by (subst rec_constr_unfold,simp)
qed
lemma rec_constr_closed :
assumes "f:Pow_rel(M,G)ââMâ G" "Ord(α)" "M(G)" "M(α)"
shows "M(rec_constr(f,α))"
using transM[OF rec_constr_type â¹M(G)âº] assms by auto
lemma lambda_rec_constr_closed :
assumes "Ord(γ)" "M(γ)" "M(f)" "f:Pow_rel(M,G)ââMâ G" "M(G)"
shows "M(λαâγ . rec_constr(f,α))"
using lam_closed2[OF cardinal_lib_assms6(1),unfolded rec_constr_def[symmetric],of f γ]
rec_constr_type[OF â¹fâ_⺠Ord_in_Ord[of γ]] transM[OF _ â¹M(G)âº] assms
by simp
textâ¹The next lemma is an application of recursive constructions.
It works under the assumption that whenever the already constructed
subsequence is small enough, another element can be added.âº
lemma bounded_cardinal_rel_selection:
includes Ord_dests
assumes
"âZ. |Z|âMâ < γ â¹ Z â G â¹ M(Z) â¹ âaâG. âsâZ. <s,a>âQ" "bâG" "Card_rel(M,γ)"
"M(G)" "M(Q)" "M(γ)"
shows
"âS[M]. S : γ ââMâ G ⧠(âα â γ. âβ â γ. α<β ⶠ<S`α,S`β>âQ)"
proof -
from assms
have "M(x) â¹ M({a â G . âsâx. â¨s, aâ© â Q})" for x
using cdlt_assms' by simp
let ?cdltγ="{ZâPow_rel(M,G) . |Z|âMâ<γ}"
and ?inQ="λY.{aâG. âsâY. <s,a>âQ}"
from â¹M(G)⺠â¹Card_rel(M,γ)⺠â¹M(γ)âº
have "M(?cdltγ)" "Ord(γ)"
using cardinal_lib_assms5[OF â¹M(γ)âº] Card_rel_is_Ord
by simp_all
from assms
have H:"âa. a â ?inQ(Y)" if "Yâ?cdltγ" for Y
proof -
{
fix Y
assume "Yâ?cdltγ"
then
have A:"YâPow_rel(M,G)" "|Y|âMâ<γ" by simp_all
then
have "YâG" "M(Y)" using Pow_rel_char[OF â¹M(G)âº] by simp_all
with A
obtain a where "aâG" "âsâY. <s,a>âQ"
using assms(1) by force
with â¹M(G)âº
have "âa. a â ?inQ(Y)" by auto
}
then show ?thesis using that by simp
qed
then
have "âf[M]. f â Pi_rel(M,?cdltγ,?inQ) ⧠f â Pi(?cdltγ,?inQ)"
proof -
from â¹âx. M(x) â¹ M({a â G . âsâx. â¨s, aâ© â Q})⺠â¹M(G)âº
have "x â {Z â PowâMâ(G) . |Z|âMâ < γ} â¹ M({a â G . âsâx. â¨s, aâ© â Q})" for x
by (auto dest:transM)
withâ¹M(G)⺠â¹âx. M(x) â¹ M({a â G . âsâx. â¨s, aâ© â Q})⺠â¹M(Q)⺠â¹M(?cdltγ)âº
interpret M_Pi_assumptions_choice M ?cdltγ ?inQ
using cdlt_assms[where Q=Q] lam_replacement_Collect_ball_Pair[THEN
lam_replacement_imp_strong_replacement] surj_imp_inj_replacement3
lam_replacement_hcomp2[OF lam_replacement_constant
lam_replacement_Collect_ball_Pair _ _ lam_replacement_minimum,
unfolded lam_replacement_def]
lam_replacement_hcomp lam_replacement_Sigfun[OF
lam_replacement_Collect_ball_Pair, of G Q, THEN
lam_replacement_imp_strong_replacement] cdlt_assms'
by unfold_locales (blast dest: transM, auto dest:transM)
show ?thesis using AC_Pi_rel Pi_rel_char H by auto
qed
then
obtain f where f_type:"f â Pi_rel(M,?cdltγ,?inQ)" "f â Pi(?cdltγ,?inQ)" and "M(f)"
by auto
moreover
define Cb where "Cb ⡠λ_âPow_rel(M,G)-?cdltγ. b"
moreover from â¹bâG⺠â¹M(?cdltγ)⺠â¹M(G)âº
have "Cb â Pow_rel(M,G)-?cdltγ â G" "M(Cb)"
using lam_closed[of "λ_.b" "Pow_rel(M,G)-?cdltγ"]
tag_replacement transM[OF â¹bâGâº]
unfolding Cb_def by auto
moreover
note â¹Card_rel(M,γ)âº
ultimately
have "f ⪠Cb : (âxâPow_rel(M,G). ?inQ(x) ⪠G)" using
fun_Pi_disjoint_Un[ of f ?cdltγ ?inQ Cb "Pow_rel(M,G)-?cdltγ" "λ_.G"]
Diff_partition[of "{ZâPow_rel(M,G). |Z|âMâ<γ}" "Pow_rel(M,G)", OF Collect_subset]
by auto
moreover
have "?inQ(x) ⪠G = G" for x by auto
moreover from calculation
have "f ⪠Cb : Pow_rel(M,G) â G"
using function_space_rel_char by simp
ultimately
have "f ⪠Cb : Pow_rel(M,G) ââMâ G"
using function_space_rel_char â¹M(f)⺠â¹M(Cb)⺠Pow_rel_closed â¹M(G)âº
by auto
define S where "Sâ¡Î»Î±âγ. rec_constr(f ⪠Cb, α)"
from â¹f ⪠Cb: Pow_rel(M,G) ââMâ G⺠â¹Card_rel(M,γ)⺠â¹M(γ)⺠â¹M(G)âº
have "S : γ â G" "M(f ⪠Cb)"
unfolding S_def
using Ord_in_Ord[OF Card_rel_is_Ord] rec_constr_type lam_type transM[OF _ â¹M(γ)âº]
function_space_rel_char
by auto
moreover from â¹fâªCb â _ââMâ G⺠â¹Card_rel(M,γ)⺠â¹M(γ)⺠â¹M(G)⺠â¹M(f ⪠Cb)⺠â¹Ord(γ)âº
have "M(S)"
unfolding S_def
using lambda_rec_constr_closed
by simp
moreover
have "âαâγ. âβâγ. α < β ⶠ<S ` α, S ` β>âQ"
proof (intro ballI impI)
fix α β
assume "βâγ"
with â¹Card_rel(M,γ)⺠â¹M(S)⺠â¹M(γ)âº
have "βâγ" "M(S``β)" "M(β)" "{S`x . x â β} = {restrict(S,β)`x . x â β}"
using transM[OF â¹Î²âγ⺠â¹M(γ)âº] image_closed Card_rel_is_Ord OrdmemD
by auto
with â¹Î²â_⺠â¹Card_rel(M,γ)⺠â¹M(γ)âº
have "{rec_constr(f ⪠Cb, x) . xâβ} = {S`x . x â β}"
using Ord_trans[OF _ _ Card_rel_is_Ord, of _ β γ]
unfolding S_def
by auto
moreover from â¹Î²âγ⺠â¹S : γ â G⺠â¹Card_rel(M,γ)⺠â¹M(γ)⺠â¹M(S``β)âº
have "{S`x . x â β} â G" "M({S`x . x â β})"
using Ord_trans[OF _ _ Card_rel_is_Ord, of _ β γ]
apply_type[of S γ "λ_. G"]
by(auto,simp add:image_fun_subset[OF â¹Sâ_⺠â¹Î²â_âº])
moreover from â¹Card_rel(M,γ)⺠â¹Î²âγ⺠â¹Sâ_⺠â¹Î²âγ⺠â¹M(S)⺠â¹M(β)⺠â¹M(G)⺠â¹M(γ)âº
have "|{S`x . x â β}|âMâ < γ"
using
â¹{S`x . xâβ} = {restrict(S,β)`x . xâβ}âº[symmetric]
cardinal_rel_RepFun_apply_le[of "restrict(S,β)" β G,
OF restrict_type2[of S γ "λ_.G" β] restrict_closed]
Ord_in_Ord Ord_cardinal_rel
lt_trans1[of "|{S`x . x â β}|âMâ" "|β|âMâ" γ]
Card_rel_lt_iff[THEN iffD2, of β γ, OF _ _ _ _ ltI]
Card_rel_is_Ord
by auto
moreover
have "âxâβ. <S`x, f ` {S`x . x â β}> â Q"
proof -
from calculation and f_type
have "f ` {S`x . x â β} â {aâG. âxâβ. <S`x,a>âQ}"
using apply_type[of f ?cdltγ ?inQ "{S`x . x â β}"]
Pow_rel_char[OF â¹M(G)âº]
by simp
then
show ?thesis by simp
qed
moreover
assume "αâγ" "α < β"
moreover from this
have "αâβ" using ltD by simp
moreover
note â¹Î²âγ⺠â¹Cb â Pow_rel(M,G)-?cdltγ â Gâº
ultimately
show "<S ` α, S ` β>âQ"
using fun_disjoint_apply1[of "{S`x . x â β}" Cb f]
domain_of_fun[of Cb] ltD[of α β]
by (subst (2) S_def, auto) (subst rec_constr_unfold, auto)
qed
moreover
note â¹M(G)⺠â¹M(γ)âº
ultimately
show ?thesis using function_space_rel_char by auto
qed
textâ¹The following basic result can, in turn, be proved by a
bounded-cardinal\_rel selection.âº
lemma Infinite_iff_lepoll_rel_nat: "M(Z) â¹ Infinite(Z) â· Ï â²âMâ Z"
proof
define Distinct where "Distinct = {<x,y> â ZÃZ . xâ y}"
have "Distinct = {xy â ZÃZ . âa b. xy = â¨a, b⩠⧠a â b}" (is "_=?A")
unfolding Distinct_def by auto
moreover
assume "Infinite(Z)" "M(Z)"
moreover from calculation
have "M(Distinct)"
using cardinal_lib_assms6 separation_dist by simp
from â¹Infinite(Z)⺠â¹M(Z)âº
obtain b where "bâZ"
using Infinite_not_empty by auto
{
fix Y
assume "|Y|âMâ < Ï" "M(Y)"
then
have "Finite(Y)"
using Finite_cardinal_rel_iff' ltD nat_into_Finite by auto
with â¹Infinite(Z)âº
have "Z â Y" by auto
}
moreover
have "(âW. M(W) â¹ |W|âMâ < Ï â¹ W â Z â¹ âaâZ. âsâW. <s,a>âDistinct)"
proof -
fix W
assume "M(W)" "|W|âMâ < Ï" "W â Z"
moreover from this
have "Finite_rel(M,W)"
using
cardinal_rel_closed[OF â¹M(W)âº] Card_rel_nat
lt_Card_rel_imp_lesspoll_rel[of Ï,simplified,OF _ â¹|W|âMâ < Ïâº]
lesspoll_rel_nat_is_Finite_rel[of W]
eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym[OF cardinal_rel_eqpoll_rel,of W]
lesspoll_rel_trans1[of W "|W|âMâ" Ï] by auto
moreover from calculation
have "¬ZâW"
using equalityI â¹Infinite(Z)⺠by auto
moreover from calculation
show "âaâZ. âsâW. <s,a>âDistinct"
unfolding Distinct_def by auto
qed
moreover from â¹bâZ⺠â¹M(Z)⺠â¹M(Distinct)⺠this
obtain S where "S : Ï ââMâ Z" "M(S)" "âαâÏ. âβâÏ. α < β ⶠ<S`α,S`β> â Distinct"
using bounded_cardinal_rel_selection[OF _ â¹bâZ⺠Card_rel_nat,of Distinct]
by blast
moreover from this
have "α â Ï â¹ Î² â Ï â¹ Î±â β â¹ S`α â S`β" for α β
unfolding Distinct_def
by (rule_tac lt_neq_symmetry[of "Ï" "λα β. S`α â S`β"])
auto
moreover from this â¹Sâ_⺠â¹M(Z)âº
have "Sâinj(Ï,Z)" using function_space_rel_char unfolding inj_def by auto
ultimately
show "Ï â²âMâ Z"
unfolding lepoll_rel_def using inj_rel_char â¹M(Z)⺠by auto
next
assume "Ï â²âMâ Z" "M(Z)"
then
show "Infinite(Z)" using lepoll_rel_nat_imp_Infinite by simp
qed
lemma Infinite_InfCard_rel_cardinal_rel: "Infinite(Z) â¹ M(Z) â¹ InfCard_rel(M,|Z|âMâ)"
using lepoll_rel_eq_trans eqpoll_rel_sym lepoll_rel_nat_imp_Infinite
Infinite_iff_lepoll_rel_nat Inf_Card_rel_is_InfCard_rel cardinal_rel_eqpoll_rel
by simp
lemma (in M_trans) mem_F_bound2:
fixes F A
defines "F ⡠λ_ x. if M(x) then A-``{x} else 0"
shows "xâF(A,c) â¹ c â (range(f) ⪠range(A))"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
lemma Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq:
assumes "F â Finite_to_one_rel(M,Z,Y) â© surj_rel(M,Z,Y)" "Infinite(Z)" "M(Z)" "M(Y)"
shows "|Y|âMâ = |Z|âMâ"
proof -
have sep_true: "separation(M, M)" unfolding separation_def by auto
note â¹M(Z)⺠â¹M(Y)âº
moreover from this assms
have "M(F)" "F â Z â Y"
unfolding Finite_to_one_rel_def
using function_space_rel_char by simp_all
moreover from this
have "x â (if M(i) then F -`` {i} else 0) â¹ M(i)" for x i
by (cases "M(i)") auto
moreover from calculation
interpret M_replacement_lepoll M "λ_ x. if M(x) then F-``{x} else 0"
using lam_replacement_inj_rel mem_F_bound2 cardinal_lib_assms3
lam_replacement_vimage_sing_fun
lam_replacement_if[OF _
lam_replacement_constant[OF nonempty],where b=M] sep_true
by (unfold_locales, simp_all)
(rule lam_Least_assumption_general[where U="λ_. range(F)"], auto)
have "w â (if M(y) then F-``{y} else 0) â¹ M(y)" for w y
by (cases "M(y)") auto
moreover from â¹Fâ_â©_âº
have 0:"Finite(F-``{y})" if "yâY" for y
unfolding Finite_to_one_rel_def
using vimage_fun_sing â¹FâZâY⺠transM[OF that â¹M(Y)âº] transM[OF _ â¹M(Z)âº] that by simp
ultimately
interpret M_cardinal_UN_lepoll _ "λy. if M(y) then F-``{y} else 0" Y
using cardinal_lib_assms3 lepoll_assumptions
by unfold_locales (auto dest:transM simp del:mem_inj_abs)
from â¹FâZâYâº
have "Z = (âyâY. {xâZ . F`x = y})"
using apply_type by auto
then
show ?thesis
proof (cases "Finite(Y)")
case True
with â¹Z = (âyâY. {xâZ . F`x = y})⺠and assms and â¹FâZâYâº
show ?thesis
using Finite_RepFun[THEN [2] Finite_Union, of Y "λy. F-``{y}"] 0 vimage_fun_sing[OF â¹FâZâYâº]
by simp
next
case False
moreover from this â¹M(Y)âº
have "Y â²âMâ |Y|âMâ"
using cardinal_rel_eqpoll_rel eqpoll_rel_sym eqpoll_rel_imp_lepoll_rel by auto
moreover
note assms
moreover from â¹Fâ_â©_âº
have "Finite({xâZ . F`x = y})" "M(F-``{y})" if "yâY" for y
unfolding Finite_to_one_rel_def
using transM[OF that â¹M(Y)âº] transM[OF _ â¹M(Z)âº] vimage_fun_sing[OF â¹FâZâYâº] that
by simp_all
moreover from calculation
have "|{xâZ . F`x = y}|âMâ â Ï" if "yâY" for y
using Finite_cardinal_rel_in_nat that transM[OF that â¹M(Y)âº] vimage_fun_sing[OF â¹FâZâYâº] that
by simp
moreover from calculation
have "|{xâZ . F`x = y}|âMâ ⤠|Y|âMâ" if "yâY" for y
using Infinite_imp_nats_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
of _ "|{xâZ . F`x = y}|âMâ"]
that cardinal_rel_idem transM[OF that â¹M(Y)âº] vimage_fun_sing[OF â¹FâZâYâº]
by auto
ultimately
have "|âyâY. {xâZ . F`x = y}|âMâ ⤠|Y|âMâ"
using leqpoll_rel_imp_cardinal_rel_UN_le
Infinite_InfCard_rel_cardinal_rel[of Y] vimage_fun_sing[OF â¹FâZâYâº]
by(auto simp add:transM[OF _ â¹M(Y)âº])
moreover from â¹F â Finite_to_one_rel(M,Z,Y) â© surj_rel(M,Z,Y)⺠â¹M(Z)⺠â¹M(F)⺠â¹M(Y)âº
have "|Y|âMâ ⤠|Z|âMâ"
using surj_rel_implies_cardinal_rel_le by auto
moreover
note â¹Z = (âyâY. {xâZ . F`x = y})âº
ultimately
show ?thesis
using le_anti_sym by auto
qed
qed
lemma cardinal_rel_map_Un:
assumes "Infinite(X)" "Finite(b)" "M(X)" "M(b)"
shows "|{a ⪠b . a â X}|âMâ = |X|âMâ"
proof -
have "(λaâX. a ⪠b) â Finite_to_one_rel(M,X,{a ⪠b . a â X})"
"(λaâX. a ⪠b) â surj_rel(M,X,{a ⪠b . a â X})"
"M({a ⪠b . a â X})"
unfolding def_surj_rel
proof
fix d
have "Finite({a â X . a ⪠b = d})" (is "Finite(?Y(b,d))")
using â¹Finite(b)âº
proof (induct arbitrary:d)
case 0
have "{a â X . a ⪠0 = d} = (if dâX then {d} else 0)"
by auto
then
show ?case by simp
next
case (cons c b)
from â¹c â bâº
have "?Y(cons(c,b),d) â (if câd then ?Y(b,d) ⪠?Y(b,d-{c}) else 0)"
by auto
with cons
show ?case
using subset_Finite
by simp
qed
moreover
assume "d â {x ⪠b . x â X}"
ultimately
show "Finite({a â X . M(a) ⧠(λxâX. x ⪠b) ` a = d})"
using subset_Finite[of "{a â X . M(a) ⧠(λxâX. x ⪠b) ` a = d}"
"{a â X . (λxâX. x ⪠b) ` a = d}"] by auto
next
note â¹M(X)⺠â¹M(b)âº
moreover
show "M(λaâX. a ⪠b)"
using lam_closed[of "λ x . xâªb",OF _ â¹M(X)âº] Un_closed[OF transM[OF _ â¹M(X)âº] â¹M(b)âº]
tag_union_replacement[OF â¹M(b)âº]
by simp
moreover from this
have "{a ⪠b . a â X} = (λxâX. x ⪠b) `` X"
using image_lam by simp
with calculation
show "M({a ⪠b . a â X})" by auto
moreover from calculation
show "(λaâX. a ⪠b) â X ââMâ {a ⪠b . a â X}"
using function_space_rel_char by (auto intro:lam_funtype)
ultimately
show "(λaâX. a ⪠b) â surjâMâ(X,{a ⪠b . a â X})" "M({a ⪠b . a â X})"
using surj_rel_char function_space_rel_char
unfolding surj_def by auto
next
qed (simp add:â¹M(X)âº)
moreover from assms this
show ?thesis
using Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq by simp
qed
subsectionâ¹Results on relative cardinal exponentiationâº
lemma cexp_rel_eqpoll_rel_cong:
assumes
"A ââMâ A'" "B ââMâ B'" "M(A)" "M(A')" "M(B)" "M(B')"
shows
"AââB,Mâ = A'ââB',Mâ"
unfolding cexp_rel_def using cardinal_rel_eqpoll_rel_iff
function_space_rel_eqpoll_rel_cong assms
by simp
lemma cexp_rel_cexp_rel_cmult:
assumes "M(κ)" "M(ν1)" "M(ν2)"
shows "(κââν1,Mâ)ââν2,Mâ = κââν2 ââMâ ν1,Mâ"
proof -
have "(κââν1,Mâ)ââν2,Mâ = (ν1 ââMâ κ)ââν2,Mâ"
using cardinal_rel_eqpoll_rel
by (intro cexp_rel_eqpoll_rel_cong) (simp_all add:assms cexp_rel_def)
also from assms
have " ⦠= κââν2 à ν1,Mâ"
unfolding cexp_rel_def using curry_eqpoll_rel[THEN cardinal_rel_cong] by blast
also
have " ⦠= κââν2 ââMâ ν1,Mâ"
using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
unfolding cmult_rel_def by (intro cexp_rel_eqpoll_rel_cong) (auto simp add:assms)
finally
show ?thesis .
qed
lemma cardinal_rel_Pow_rel: "M(X) â¹ |Pow_rel(M,X)|âMâ = 2ââX,Mâ"
using cardinal_rel_eqpoll_rel_iff[THEN iffD2,
OF _ _ Pow_rel_eqpoll_rel_function_space_rel]
unfolding cexp_rel_def by simp
lemma cantor_cexp_rel:
assumes "Card_rel(M,ν)" "M(ν)"
shows "ν < 2ââν,Mâ"
using assms Card_rel_is_Ord Card_rel_cexp_rel
proof (intro not_le_iff_lt[THEN iffD1] notI)
assume "2ââν,Mâ ⤠ν"
with assms
have "|Pow_rel(M,ν)|âMâ ⤠ν"
using cardinal_rel_Pow_rel[of ν] by simp
with assms
have "Pow_rel(M,ν) â²âMâ ν"
using cardinal_rel_eqpoll_rel_iff Card_rel_le_imp_lepoll_rel Card_rel_cardinal_rel_eq
by auto
then
obtain g where "g â inj_rel(M,Pow_rel(M,ν), ν)"
by blast
moreover
note â¹M(ν)âº
moreover from calculation
have "M(g)" by (auto dest:transM)
ultimately
show "False"
using cantor_inj_rel by simp
qed simp
lemma countable_iff_lesspoll_rel_Aleph_rel_one:
notes iff_trans[trans]
assumes "M(C)"
shows "countableâMâ(C) â· C âºâMâ âµâ1ââMâ"
using assms lesspoll_rel_csucc_rel[of Ï C] Aleph_rel_succ Aleph_rel_zero
unfolding countable_rel_def by simp
lemma countable_iff_le_rel_Aleph_rel_one:
notes iff_trans[trans]
assumes "M(C)"
shows "countableâMâ(C) â· |C|âMâ âºâMâ âµâ1ââMâ"
proof -
from assms
have "countableâMâ(C) â· C âºâMâ âµâ1ââMâ"
using countable_iff_lesspoll_rel_Aleph_rel_one
by simp
also from assms
have "⦠ⷠ|C|âMâ âºâMâ âµâ1ââMâ"
using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eq_lesspoll_rel_trans]
by (auto intro:cardinal_rel_eqpoll_rel[THEN eq_lesspoll_rel_trans])
finally
show ?thesis .
qed
end
lemma (in M_cardinal_library) countable_fun_imp_countable_image:
assumes "f:C ââMâ B" "countableâMâ(C)" "âc. câC â¹ countableâMâ(f`c)"
"M(C)" "M(B)"
shows "countableâMâ(â(f``C))"
using assms function_space_rel_char image_fun[of f]
cardinal_rel_RepFun_apply_le[of f C B]
countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ ]
countable_rel_iff_cardinal_rel_le_nat
by (rule_tac countable_rel_union_countable_rel)
(auto dest:transM del:imageE)
end ad>
Theory Delta_System_Relative
sectionâ¹The Delta System Lemma, Relativized\label{sec:dsl-rel}âº
theory Delta_System_Relative
imports
Cardinal_Library_Relative
begin
definition
delta_system :: "i â o" where
"delta_system(D) â¡ âr. âAâD. âBâD. A â B ⶠA â© B = r"
lemma delta_systemI[intro]:
assumes "âAâD. âBâD. A â B ⶠA â© B = r"
shows "delta_system(D)"
using assms unfolding delta_system_def by simp
lemma delta_systemD[dest]:
"delta_system(D) â¹ âr. âAâD. âBâD. A â B ⶠA â© B = r"
unfolding delta_system_def by simp
lemma delta_system_root_eq_Inter:
assumes "delta_system(D)"
shows "âAâD. âBâD. A â B ⶠA â© B = âD"
proof (clarify, intro equalityI, auto)
fix A' B' x C
assume hyp:"A'âD" "B'â D" "A'â B'" "xâA'" "xâB'" "CâD"
with assms
obtain r where delta:"âAâD. âBâD. A â B ⶠA â© B = r"
by auto
show "x â C"
proof (cases "C=A'")
case True
with hyp and assms
show ?thesis by simp
next
case False
moreover
note hyp
moreover from calculation and delta
have "r = C â© A'" "A' â© B' = r" "xâr" by auto
ultimately
show ?thesis by simp
qed
qed
relativize functional "delta_system" "delta_system_rel" external
locale M_delta = M_cardinal_library +
assumes
countable_lepoll_assms:
"M(G) â¹ M(A) â¹ M(b) â¹ M(f) â¹ separation(M, λy. âxâA.
y = â¨x, μ i. x â if_range_F_else_F(λx. {xa â G . x â xa}, b, f, i)â©)"
begin
lemmas cardinal_replacement = lam_replacement_cardinal_rel[unfolded lam_replacement_def]
lemma disjoint_separation: "M(c) â¹ separation(M, λ x. âa. âb. x=â¨a,b⩠⧠a â© b = c)"
using separation_pair separation_eq lam_replacement_constant lam_replacement_Int
by simp
lemma insnd_ball: "M(G) â¹ separation(M, λp. âxâG. x â snd(p) â· fst(p) â x)"
using separation_ball separation_iff' lam_replacement_fst lam_replacement_snd
separation_in lam_replacement_hcomp
by simp
lemma (in M_trans) mem_F_bound6:
fixes F G
defines "F ⡠λ_ x. Collect(G, (â)(x))"
shows "xâF(G,c) â¹ c â (range(f) ⪠âG)"
using apply_0 unfolding F_def
by (cases "M(c)", auto simp:F_def)
lemma delta_system_Aleph_rel1:
assumes "âAâF. Finite(A)" "F ââMâ âµâ1ââMâ" "M(F)"
shows "âD[M]. D â F ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ"
proof -
have "M(G) â¹ M(p) â¹ M({AâG . p â A})" for G p
proof -
assume "M(G)" "M(p)"
have "{AâG . p â A} = G â© (Memrel({p} ⪠G) `` {p})"
unfolding Memrel_def by auto
with â¹M(G)⺠â¹M(p)âº
show ?thesis by simp
qed
from â¹M(F)âº
have "M(λAâF. |A|âMâ)"
using cardinal_replacement
by (rule_tac lam_closed) (auto dest:transM)
textâ¹Since all members are finite,âº
with â¹âAâF. Finite(A)⺠â¹M(F)âº
have "(λAâF. |A|âMâ) : F ââMâ Ï" (is "?cards : _")
by (simp add:mem_function_space_rel_abs, rule_tac lam_type)
(force dest:transM)
moreover from this
have a:"?cards -`` {n} = { AâF . |A|âMâ = n }" for n
using vimage_lam by auto
moreover
note â¹F ââMâ âµâ1ââMâ⺠â¹M(F)âº
moreover from calculation
textâ¹there are uncountably many have the same cardinal:âº
obtain n where "nâÏ" "|?cards -`` {n}|âMâ = âµâ1ââMâ"
using eqpoll_rel_Aleph_rel1_cardinal_rel_vimage[of F ?cards] by auto
moreover
define G where "G â¡ ?cards -`` {n}"
moreover from calculation and â¹M(?cards)âº
have "M(G)" by blast
moreover from calculation
have "G â F" by auto
ultimately
textâ¹Therefore, without loss of generality, we can assume that all
elements of the family have cardinality \<^term>â¹nâÏâº.âº
have "AâG â¹ |A|âMâ = n" and "G ââMâ âµâ1ââMâ" and "M(G)" for A
using cardinal_rel_Card_rel_eqpoll_rel_iff by auto
with â¹nâÏâº
textâ¹So we prove the result by induction on this \<^term>â¹n⺠and
generalizing \<^term>â¹Gâº, since the argument requires changing the
family in order to apply the inductive hypothesis.âº
have "âD[M]. D â G ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ"
proof (induct arbitrary:G)
case 0
then
have "G â {0}"
using cardinal_rel_0_iff_0 by (blast dest:transM)
with â¹G ââMâ âµâ1ââMâ⺠â¹M(G)âº
show ?case
using nat_lt_Aleph_rel1 subset_imp_le_cardinal_rel[of G "{0}"]
lt_trans2 cardinal_rel_Card_rel_eqpoll_rel_iff by auto
next
case (succ n)
have "âaâG. Finite(a)"
proof
fix a
assume "a â G"
moreover
note â¹M(G)⺠â¹nâÏâº
moreover from calculation
have "M(a)" by (auto dest: transM)
moreover from succ and â¹aâGâº
have "|a|âMâ = succ(n)" by simp
ultimately
show "Finite(a)"
using Finite_cardinal_rel_iff' nat_into_Finite[of "succ(n)"]
by fastforce
qed
show "âD[M]. D â G ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ"
proof (cases "âp[M]. {AâG . p â A} ââMâ âµâ1ââMâ")
case True
then
obtain p where "{AâG . p â A} ââMâ âµâ1ââMâ" "M(p)" by blast
moreover
note 1=â¹M(G)⺠â¹M(G) â¹ M(p) â¹ M({AâG . p â A})⺠singleton_closed[OF â¹M(p)âº]
moreover from this
have "M({x - {p} . x â {x â G . p â x}})"
using RepFun_closed[OF lam_replacement_Diff'[THEN
lam_replacement_imp_strong_replacement]]
Diff_closed[OF transM[OF _ 1(2)]] by auto
moreover from 1
have "M(converse(λxâ{x â G . p â x}. x - {p}))" (is "M(converse(?h))")
using converse_closed[of ?h] lam_closed[OF diff_Pair_replacement]
Diff_closed[OF transM[OF _ 1(2)]]
by auto
moreover from calculation
have "{A-{p} . Aâ{XâG. pâX}} ââMâ âµâ1ââMâ" (is "?F ââMâ _")
using Diff_bij_rel[of "{AâG . p â A}" "{p}", THEN
comp_bij_rel[OF bij_rel_converse_bij_rel, where C="âµâ1ââMâ",
THEN bij_rel_imp_eqpoll_rel, of _ _ ?F]]
unfolding eqpoll_rel_def
by (auto simp del:mem_bij_abs)
textâ¹Now using the hypothesis of the successor case,âº
moreover from â¹âA. AâG â¹ |A|âMâ=succ(n)⺠â¹âaâG. Finite(a)âº
and this â¹M(G)âº
have "pâA â¹ AâG â¹ |A - {p}|âMâ = n" for A
using Finite_imp_succ_cardinal_rel_Diff[of _ p] by (force dest: transM)
moreover
have "âaâ?F. Finite(a)"
proof (clarsimp)
fix A
assume "pâA" "AâG"
with â¹âA. p â A â¹ A â G â¹ |A - {p}|âMâ = n⺠and â¹nâÏ⺠â¹M(G)âº
have "Finite(|A - {p}|âMâ)"
using nat_into_Finite by simp
moreover from â¹pâA⺠â¹AâG⺠â¹M(G)âº
have "M(A - {p})" by (auto dest: transM)
ultimately
show "Finite(A - {p})"
using Finite_cardinal_rel_iff' by simp
qed
moreover
textâ¹we may apply the inductive hypothesis to the new family \<^term>â¹?Fâº:âº
note â¹(âA. A â ?F â¹ |A|âMâ = n) â¹ ?F ââMâ âµâ1ââMâ â¹ M(?F) â¹
âD[M]. D â ?F ⧠delta_system(D) ⧠D ââMâ âµâ1ââMââº
moreover
note 1=â¹M(G)⺠â¹M(G) â¹ M(p) â¹ M({AâG . p â A})⺠singleton_closed[OF â¹M(p)âº]
moreover from this
have "M({x - {p} . x â {x â G . p â x}})"
using RepFun_closed[OF lam_replacement_Diff'[THEN
lam_replacement_imp_strong_replacement]]
Diff_closed[OF transM[OF _ 1(2)]] by auto
ultimately
obtain D where "Dâ{A-{p} . Aâ{XâG. pâX}}" "delta_system(D)" "D ââMâ âµâ1ââMâ" "M(D)"
by auto
moreover from this
obtain r where "âAâD. âBâD. A â B ⶠA â© B = r"
by fastforce
then
have "âAâD.âBâD. Aâª{p} â Bâª{p}â¶(A ⪠{p}) â© (B ⪠{p}) = râª{p}"
by blast
ultimately
have "delta_system({B ⪠{p} . BâD})" (is "delta_system(?D)")
by fastforce
moreover from â¹M(D)⺠â¹M(p)âº
have "M(?D)"
using RepFun_closed un_Pair_replacement transM[of _ D] by auto
moreover from â¹D ââMâ âµâ1ââMâ⺠â¹M(D)âº
have "Infinite(D)" "|D|âMâ = âµâ1ââMâ"
using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[THEN iffD2,
THEN uncountable_rel_imp_Infinite, of D]
cardinal_rel_eqpoll_rel_iff[of D "âµâ1ââMâ"] â¹M(D)⺠â¹D ââMâ âµâ1ââMââº
by auto
moreover from this â¹M(?D)⺠â¹M(D)⺠â¹M(p)âº
have "?D ââMâ âµâ1ââMâ"
using cardinal_rel_map_Un[of D "{p}"] naturals_lt_nat
cardinal_rel_eqpoll_rel_iff[THEN iffD1] by simp
moreover
note â¹D â {A-{p} . Aâ{XâG. pâX}}âº
have "?D â G"
proof -
{
fix A
assume "AâG" "pâA"
moreover from this
have "A = A - {p} ⪠{p}"
by blast
ultimately
have "A -{p} ⪠{p} â G"
by auto
}
with â¹D â {A-{p} . Aâ{XâG. pâX}}âº
show ?thesis
by blast
qed
moreover
note â¹M(?D)âº
ultimately
show "âD[M]. D â G ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ" by auto
next
case False
note â¹Â¬ (âp[M]. {A â G . p â A} ââMâ âµâ1ââMâ)âº
â¹M(G)⺠â¹âp. M(G) â¹ M(p) â¹ M({AâG . p â A})âº
moreover from â¹G ââMâ âµâ1ââMâ⺠and this
have "M(p) â¹ {A â G . p â A} â²âMâ âµâ1ââMâ" (is "_ â¹ ?G(p) â²âMâ _") for p
by (auto intro!:lepoll_rel_eq_trans[OF subset_imp_lepoll_rel] dest:transM)
moreover from calculation
have "M(p) â¹ ?G(p) âºâMâ âµâ1ââMâ" for p
using â¹M(G) â¹ M(p) â¹ M({AâG . p â A})âº
unfolding lesspoll_rel_def by simp
moreover from calculation
have "M(p) â¹ ?G(p) â²âMâ Ï" for p
using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero by auto
moreover
have "{A â G . S â© A â 0} = (âpâS. ?G(p))" for S
by auto
moreover from calculation
have "M(S) â¹ i â S â¹ M({x â G . i â x})" for i S
by (auto dest: transM)
moreover
have "M(S) â¹ countable_rel(M,S) â¹ countable_rel(M,{A â G . S â© A â 0})" for S
proof -
from â¹M(G)âº
interpret M_replacement_lepoll M "λ_ x. Collect(G, (â)(x))"
using countable_lepoll_assms lam_replacement_inj_rel separation_in_rev
lam_replacement_Collect[OF _ _ insnd_ball] mem_F_bound6[of _ G]
by unfold_locales
(auto dest:transM intro:lam_Least_assumption_general[of _ _ _ _ Union])
fix S
assume "M(S)"
with â¹M(G)⺠â¹âi. M(S) â¹ i â S â¹ M({x â G . i â x})âº
interpret M_cardinal_UN_lepoll _ ?G S
using lepoll_assumptions
by unfold_locales (auto dest:transM)
assume "countable_rel(M,S)"
with â¹M(S)⺠calculation(6) calculation(7,8)[of S]
show "countable_rel(M,{A â G . S â© A â 0})"
using InfCard_rel_nat Card_rel_nat
le_Card_rel_iff[THEN iffD2, THEN [3] leqpoll_rel_imp_cardinal_rel_UN_le,
THEN [4] le_Card_rel_iff[THEN iffD1], of Ï] j.UN_closed
unfolding countable_rel_def by (auto dest: transM)
qed
define Disjoint where "Disjoint = {<A,B> â GÃG . B â© A = 0}"
have "Disjoint = {x â GÃG . â a b. x=<a,b> ⧠aâ©b=0}"
unfolding Disjoint_def by force
with â¹M(G)âº
have "M(Disjoint)"
using disjoint_separation by simp
textâ¹For every countable\_rel subfamily of \<^term>â¹G⺠there is another some
element disjoint from all of them:âº
have "âAâG. âSâX. <S,A>âDisjoint" if "|X|âMâ < âµâ1ââMâ" "X â G" "M(X)" for X
proof -
note â¹nâÏ⺠â¹M(G)âº
moreover from this and â¹âA. AâG â¹ |A|âMâ = succ(n)âº
have "|A|âMâ= succ(n)" "M(A)" if "AâG" for A
using that Finite_cardinal_rel_eq_cardinal[of A] Finite_cardinal_rel_iff'[of A]
nat_into_Finite transM[of A G] by (auto dest:transM)
ultimately
have "AâG â¹ Finite(A)" for A
using cardinal_rel_Card_rel_eqpoll_rel_iff[of "succ(n)" A]
Finite_cardinal_rel_eq_cardinal[of A] nat_into_Card_rel[of "succ(n)"]
nat_into_M[of n] unfolding Finite_def eqpoll_rel_def by (auto)
with â¹XâG⺠â¹M(X)âº
have "AâX â¹ countable_rel(M,A)" for A
using Finite_imp_countable_rel by (auto dest: transM)
moreover from â¹M(X)âº
have "M(âX)" by simp
moreover
note â¹|X|âMâ < âµâ1ââMâ⺠â¹M(X)âº
ultimately
have "countable_rel(M,âX)"
using Card_rel_nat[THEN cardinal_rel_lt_csucc_rel_iff, of X]
countable_rel_union_countable_rel[of X]
countable_rel_iff_cardinal_rel_le_nat[of X] Aleph_rel_succ
Aleph_rel_zero by simp
with â¹M(âX)⺠â¹M(_) â¹ countable_rel(M,_) â¹ countable_rel(M,{A â G . _ â© A â 0})âº
have "countable_rel(M,{A â G . (âX) â© A â 0})" by simp
with â¹G ââMâ âµâ1ââMâ⺠â¹M(G)âº
obtain B where "BâG" "B â {A â G . (âX) â© A â 0}"
using nat_lt_Aleph_rel1 cardinal_rel_Card_rel_eqpoll_rel_iff[of "âµâ1ââMâ" G]
uncountable_rel_not_subset_countable_rel
[of "{A â G . (âX) â© A â 0}" G]
uncountable_rel_iff_nat_lt_cardinal_rel[of G]
by force
then
have "âAâG. âSâX. A â© S = 0" by auto
with â¹XâGâº
show "âAâG. âSâX. <S,A>âDisjoint" unfolding Disjoint_def
using subsetD by simp
qed
moreover from â¹G ââMâ âµâ1ââMâ⺠â¹M(G)âº
obtain b where "bâG"
using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1
uncountable_rel_not_empty by blast
ultimately
textâ¹Hence, the hypotheses to perform a bounded-cardinal selection
are satisfied,âº
obtain S where "S:âµâ1ââMâââMâG" "αââµâ1ââMâ ⹠βââµâ1ââMâ ⹠α<β â¹ <S`α, S`β> âDisjoint"
for α β
using bounded_cardinal_rel_selection[of "âµâ1ââMâ" G Disjoint] â¹M(Disjoint)âº
by force
moreover from this â¹nâÏ⺠â¹M(G)âº
have inM:"M(S)" "M(n)" "âx. x â âµâ1ââMâ â¹ S ` x â G" "âx. x â âµâ1ââMâ â¹ M(x)"
using function_space_rel_char by (auto dest: transM)
ultimately
have "α â âµâ1ââMâ ⹠β â âµâ1ââMâ ⹠αâ β â¹ S`α â© S`β = 0" for α β
unfolding Disjoint_def
using lt_neq_symmetry[of "âµâ1ââMâ" "λα β. S`α â© S`β = 0"] Card_rel_is_Ord
by auto (blast)
textâ¹and a symmetry argument shows that obtained \<^term>â¹S⺠is
an injective \<^term>â¹âµâ1ââMââº-sequence of disjoint elements of \<^term>â¹Gâº.âº
moreover from this and â¹âA. AâG â¹ |A|âMâ = succ(n)⺠inM
â¹S : âµâ1ââMâ ââMâ G⺠â¹M(G)âº
have "S â inj_rel(M,âµâ1ââMâ, G)"
using def_inj_rel[OF Aleph_rel_closed â¹M(G)âº, of 1]
proof (clarsimp)
fix w x
from inM
have "a â âµâ1ââMâ â¹ b â âµâ1ââMâ â¹ a â b â¹ S ` a â S ` b" for a b
using â¹âA. AâG â¹ |A|âMâ = succ(n)âº[THEN [4] cardinal_rel_succ_not_0[THEN [4]
Int_eq_zero_imp_not_eq[OF calculation, of "âµâ1ââMâ" "λx. x"],
of "λ_.n"], OF _ _ _ _ apply_closed] by auto
moreover
assume "w â âµâ1ââMâ" "x â âµâ1ââMâ" "S ` w = S ` x"
ultimately
show "w = x" by blast
qed
moreover from this â¹M(G)âº
have "range(S) ââMâ âµâ1ââMâ"
using inj_rel_bij_rel_range eqpoll_rel_sym unfolding eqpoll_rel_def
by (blast dest: transM)
moreover
note â¹M(G)âº
moreover from calculation
have "range(S) â G"
using inj_rel_is_fun range_fun_subset_codomain
by (fastforce dest: transM)
moreover
note â¹M(S)âº
ultimately
show "âD[M]. D â G ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ"
using inj_rel_is_fun ZF_Library.range_eq_image[of S "âµâ1ââMâ" G]
image_function[OF fun_is_function, OF inj_rel_is_fun, of S "âµâ1ââMâ" G]
domain_of_fun[OF inj_rel_is_fun, of S "âµâ1ââMâ" G] apply_replacement[of S]
by (rule_tac x="S``âµâ1ââMâ" in rexI) (auto dest:transM intro!:RepFun_closed)
textâ¹This finishes the successor case and hence the proof.âº
qed
qed
with â¹G â Fâº
show ?thesis by blast
qed
lemma delta_system_uncountable_rel:
assumes "âAâF. Finite(A)" "uncountable_rel(M,F)" "M(F)"
shows "âD[M]. D â F ⧠delta_system(D) ⧠D ââMâ âµâ1ââMâ"
proof -
from assms
obtain S where "S â F" "S ââMâ âµâ1ââMâ" "M(S)"
using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[of F] by auto
moreover from â¹âAâF. Finite(A)⺠and this
have "âAâS. Finite(A)" by auto
ultimately
show ?thesis using delta_system_Aleph_rel1[of S]
by (auto dest:transM)
qed
end
end>
Theory Pointed_DC_Relative
sectionâ¹Relative DCâº
theory Pointed_DC_Relative
imports
Cardinal_Library_Relative
begin
consts dc_witness :: "i â i â i â i â i â i"
primrec
wit0 : "dc_witness(0,A,a,s,R) = a"
witrec : "dc_witness(succ(n),A,a,s,R) = s`{xâA. â¨dc_witness(n,A,a,s,R),xâ©âR}"
lemmas dc_witness_def = dc_witness_nat_def
relativize functional "dc_witness" "dc_witness_rel"
relationalize "dc_witness_rel" "is_dc_witness"
schematic_goal sats_is_dc_witness_fm_auto:
assumes "na < length(env)" "e < length(env)"
shows
" na â Ï â¹
A â Ï â¹
a â Ï â¹
s â Ï â¹
R â Ï â¹
e â Ï â¹
env â list(Aa) â¹
0 â Aa â¹
is_dc_witness(##Aa, nth(na, env), nth(A, env), nth(a, env), nth(s, env), nth(R, env), nth(e, env)) â·
Aa, env ⨠?fm(nat, A, a, s, R, e)"
unfolding is_dc_witness_def is_recursor_def
by (rule is_transrec_iff_sats | simp_all)
(rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp add:assms)+
synthesize "is_dc_witness" from_schematic
manual_arity for "is_dc_witness_fm"
unfolding is_dc_witness_fm_def apply (subst arity_transrec_fm)
apply (simp add:arity) defer 3
apply (simp add:arity) defer
apply (subst arity_is_nat_case_fm)
apply (simp add:arity del:arity_transrec_fm) prefer 5
by (simp add:arity del:arity_transrec_fm)+
definition dcwit_body :: "[i,i,i,i,i] â o" where
"dcwit_body(A,a,g,R) ⡠λp. snd(p) = dc_witness(fst(p), A, a, g, R)"
relativize functional "dcwit_body" "dcwit_body_rel"
relationalize "dcwit_body_rel" "is_dcwit_body"
synthesize "is_dcwit_body" from_definition assuming "nonempty"
arity_theorem for "is_dcwit_body_fm"
context M_replacement
begin
lemma dc_witness_closed[intro,simp]:
assumes "M(n)" "M(A)" "M(a)" "M(s)" "M(R)" "nânat"
shows "M(dc_witness(n,A,a,s,R))"
using â¹nânatâº
proof(induct)
case 0
with â¹M(a)âº
show ?case
unfolding dc_witness_def by simp
next
case (succ x)
with assms
have "M(dc_witness(x,A,a,s,R))" (is "M(?b)")
by simp
moreover from this assms
have "M(({?b}ÃA)â©R)" (is "M(?X)") by auto
moreover
have "{xâA. â¨?b,xâ©âR} = {snd(y) . yâ?X}" (is "_ = ?Y")
by(intro equalityI subsetI,force,auto)
moreover from calculation
have "M(?Y)"
using lam_replacement_snd lam_replacement_imp_strong_replacement RepFun_closed
snd_closed[OF transM]
by auto
ultimately
show ?case
using â¹M(s)⺠apply_closed
unfolding dc_witness_def by simp
qed
lemma dc_witness_rel_char:
assumes "M(A)"
shows "dc_witness_rel(M,n,A,a,s,R) = dc_witness(n,A,a,s,R)"
proof -
from assms
have "{x â A . â¨rec, xâ© â R} = {x â A . M(x) ⧠â¨rec, xâ© â R}" for rec
by (auto dest:transM)
then
show ?thesis
unfolding dc_witness_def dc_witness_rel_def by simp
qed
lemma (in M_basic) first_section_closed:
assumes
"M(A)" "M(a)" "M(R)"
shows "M({x â A . â¨a, xâ© â R})"
proof -
have "{x â A . â¨a, xâ© â R} = range({a} à range(R) â© R) â© A"
by (intro equalityI) auto
with assms
show ?thesis
by simp
qed
lemma witness_into_A [TC]:
assumes "aâA"
"âX[M]. Xâ 0 ⧠XâA ⶠs`XâA"
"âyâA. {xâA. â¨y,xâ©âR } â 0" "nânat"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "dc_witness(n, A, a, s, R)âA"
using â¹nânatâº
proof(induct n)
case 0
then show ?case using â¹aâA⺠by simp
next
case (succ x)
with succ assms(1,3-)
show ?case
using nat_into_M first_section_closed
by (simp, rule_tac rev_subsetD, rule_tac assms(2)[rule_format])
auto
qed
end
locale M_DC = M_trancl + M_replacement + M_eclose +
assumes
separation_is_dcwit_body:
"M(A) â¹ M(a) â¹ M(g) â¹ M(R) â¹ separation(M,is_dcwit_body(M, A, a, g, R))"
and
dcwit_replacement:"Ord(na) â¹
M(na) â¹
M(A) â¹
M(a) â¹
M(s) â¹
M(R) â¹
transrec_replacement
(M, λn f ntc.
is_nat_case
(M, a,
λm bmfm.
âfm[M]. âcp[M].
is_apply(M, f, m, fm) â§
is_Collect(M, A, λx. âfmx[M]. (M(x) ⧠fmx â R) ⧠pair(M, fm, x, fmx), cp) â§
is_apply(M, s, cp, bmfm),
n, ntc),na)"
begin
lemma is_dc_witness_iff:
assumes "Ord(na)" "M(na)" "M(A)" "M(a)" "M(s)" "M(R)" "M(res)"
shows "is_dc_witness(M, na, A, a, s, R, res) â· res = dc_witness_rel(M, na, A, a, s, R)"
proof -
note assms
moreover from this
have "{x â A . M(x) ⧠â¨f, xâ© â R} = {x â A . â¨f, xâ© â R}" for f
by (auto dest:transM)
moreover from calculation
have "M(fm) â¹ M({x â A . M(x) ⧠â¨fm, xâ© â R})" for fm
using first_section_closed by (auto dest:transM)
moreover from calculation
have "M(x) â¹ M(z) â¹ M(mesa) â¹
(âya[M]. pair(M, x, ya, z) â§
is_wfrec(M, λn f. is_nat_case(M, a, λm bmfm. âfm[M]. is_apply(M, f, m, fm) â§
is_apply(M, s, {x â A . â¨fm, xâ© â R}, bmfm), n), mesa, x, ya))
â·
(ây[M]. pair(M, x, y, z) â§
is_wfrec(M, λn f. is_nat_case(M, a,
λm bmfm.
âfm[M]. âcp[M]. is_apply(M, f, m, fm) â§
is_Collect(M, A, λx. M(x) ⧠â¨fm, xâ© â R, cp) ⧠is_apply(M, s, cp, bmfm),n),
mesa, x, y))" for x z mesa by simp
moreover from calculation
show ?thesis
using assms dcwit_replacement[of na A a s R]
unfolding is_dc_witness_def dc_witness_rel_def
by (rule_tac recursor_abs) (auto dest:transM)
qed
lemma dcwit_body_abs:
"fst(x) â Ï â¹ M(A) â¹ M(a) â¹ M(g) â¹ M(R) â¹ M(x) â¹
is_dcwit_body(M,A,a,g,R,x) â· dcwit_body(A,a,g,R,x)"
using pair_in_M_iff apply_closed transM[of _ A]
is_dc_witness_iff[of "fst(x)" "A" "a" "g" "R" "snd(x)"]
fst_snd_closed dc_witness_closed
unfolding dcwit_body_def is_dcwit_body_def
by (auto dest:transM simp:absolut dc_witness_rel_char del:bexI intro!:bexI)
lemma separation_eq_dc_witness:
"M(A) â¹
M(a) â¹
M(g) â¹
M(R) â¹ separation(M,λp. fst(p)âÏ â¶ snd(p) = dc_witness(fst(p), A, a, g, R))"
using separation_is_dcwit_body dcwit_body_abs unfolding is_dcwit_body_def
oops
lemma Lambda_dc_witness_closed:
assumes "g â PowâMâ(A)-{0} â A" "aâA" "âyâA. {x â A . â¨y, xâ© â R} â 0"
"M(g)" "M(A)" "M(a)" "M(R)"
shows "M(λnânat. dc_witness(n,A,a,g,R))"
proof -
from assms
have "(λnânat. dc_witness(n,A,a,g,R)) = {p â Ï Ã A . is_dcwit_body(M,A,a,g,R,p)}"
using witness_into_A[of a A g R]
Pow_rel_char apply_type[of g "{x â Pow(A) . M(x)}-{0}" "λ_.A"]
unfolding lam_def split_def
apply (intro equalityI subsetI)
apply (auto)
by (subst dcwit_body_abs, simp_all add:transM[of _ Ï] dcwit_body_def,
subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def)
with assms
show ?thesis
using separation_is_dcwit_body dc_witness_rel_char unfolding split_def by simp
qed
lemma witness_related:
assumes "aâA"
"âX[M]. Xâ 0 ⧠XâA ⶠs`XâX"
"âyâA. {xâA. â¨y,xâ©âR } â 0" "nânat"
"M(a)" "M(A)" "M(s)" "M(R)" "M(n)"
shows "â¨dc_witness(n, A, a, s, R),dc_witness(succ(n), A, a, s, R)â©âR"
proof -
note assms
moreover from this
have "(âX[M]. Xâ 0 ⧠XâA ⶠs`XâA)" by auto
moreover from calculation
have "dc_witness(n, A, a, s, R)âA" (is "?x â A")
using witness_into_A[of _ _ s R n] by simp
moreover from assms
have "M({x â A . â¨dc_witness(n, A, a, s, R), xâ© â R})"
using first_section_closed[of A "dc_witness(n, A, a, s, R)"]
by simp
ultimately
show ?thesis by auto
qed
lemma witness_funtype:
assumes "aâA"
"âX[M]. Xâ 0 ⧠XâA ⶠs`X â A"
"âyâA. {xâA. â¨y,xâ©âR} â 0"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "(λnânat. dc_witness(n, A, a, s, R)) â nat â A" (is "?f â _ â _")
proof -
have "?f â nat â {dc_witness(n, A, a, s, R). nânat}" (is "_ â _ â ?B")
using lam_funtype assms by simp
then
have "?B â A"
using witness_into_A assms by auto
with â¹?f â _âº
show ?thesis
using fun_weaken_type
by simp
qed
lemma witness_to_fun:
assumes "aâA"
"âX[M]. Xâ 0 ⧠XâA ⶠs`XâA"
"âyâA. {xâA. â¨y,xâ©âR } â 0"
"M(A)" "M(a)" "M(s)" "M(R)"
shows "âf â natâA. ânânat. f`n =dc_witness(n,A,a,s,R)"
using assms bexI[of _ "λnânat. dc_witness(n,A,a,s,R)"] witness_funtype
by simp
end
locale M_library_DC = M_library + M_DC
begin
lemma AC_M_func:
assumes "âx. x â A â¹ (ây. y â x)" "M(A)"
shows "âf â A ââMâ â(A). âx â A. f`x â x"
proof -
from â¹M(A)âº
interpret mpiA:M_Pi_assumptions _ A "λx. x"
using Pi_replacement Pi_separation lam_replacement_identity
lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
by unfold_locales (simp_all add:transM[of _ A])
from â¹M(A)âº
interpret mpic_A:M_Pi_assumptions_choice _ A "λx. x"
apply unfold_locales
using lam_replacement_constant lam_replacement_identity
lam_replacement_identity[THEN lam_replacement_imp_strong_replacement]
lam_replacement_minimum[THEN [5] lam_replacement_hcomp2]
unfolding lam_replacement_def[symmetric]
by auto
from â¹M(A)âº
interpret mpi2:M_Pi_assumptions2 _ A "λ_. âA" "λx. x"
using Pi_replacement Pi_separation lam_replacement_constant
lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement,
of "λ_. âA"] Pi_replacement1[of _ "âA"] transM[of _ "A"]
by unfold_locales auto
from assms
show ?thesis
using mpi2.Pi_rel_type apply_type mpiA.mem_Pi_rel_abs mpi2.mem_Pi_rel_abs
function_space_rel_char
by (rule_tac mpic_A.AC_Pi_rel[THEN rexE], simp, rule_tac x=x in bexI)
(auto, rule_tac C="λx. x" in Pi_type, auto)
qed
lemma non_empty_family: "[| 0 â A; x â A |] ==> ây. y â x"
by (subgoal_tac "x â 0", blast+)
lemma AC_M_func0: "0 â A â¹ M(A) â¹ âf â A ââMâ â(A). âx â A. f`x â x"
by (rule AC_M_func) (simp_all add: non_empty_family)
lemma AC_M_func_Pow_rel:
assumes "M(C)"
shows "âf â (PowâMâ(C)-{0}) ââMâ C. âx â PowâMâ(C)-{0}. f`x â x"
proof -
have "0âPowâMâ(C)-{0}" by simp
with assms
obtain f where "f â (PowâMâ(C)-{0}) ââMâ â(PowâMâ(C)-{0})" "âx â PowâMâ(C)-{0}. f`x â x"
using AC_M_func0[OF â¹0â_âº] by auto
moreover
have "xâC" if "x â PowâMâ(C) - {0}" for x
using that Pow_rel_char assms
by auto
moreover
have "â(PowâMâ(C) - {0}) â C"
using assms Pow_rel_char by auto
ultimately
show ?thesis
using assms function_space_rel_char
by (rule_tac bexI,auto,rule_tac Pi_weaken_type,simp_all)
qed
theorem pointed_DC:
assumes "âxâA. âyâA. â¨x,yâ©â R" "M(A)" "M(R)"
shows "âaâA. âf â natââMâ A. f`0 = a ⧠(ân â nat. â¨f`n,f`succ(n)â©âR)"
proof -
have 0:"âyâA. {x â A . â¨y, xâ© â R} â 0"
using assms by auto
from â¹M(A)âº
obtain g where 1: "g â PowâMâ(A)-{0} â A" "âX[M]. X â 0 ⧠X â A ⶠg ` X â X"
"M(g)"
using AC_M_func_Pow_rel[of A] mem_Pow_rel_abs
function_space_rel_char[of "PowâMâ(A)-{0}" A] by auto
then
have 2:"âX[M]. X â 0 ⧠X â A ⶠg ` X â A" by auto
{
fix a
assume "aâA"
let ?f ="λnânat. dc_witness(n,A,a,g,R)"
note â¹aâAâº
moreover from this
have f0: "?f`0 = a" by simp
moreover
note â¹aâA⺠â¹M(g)⺠â¹M(A)⺠â¹M(R)âº
moreover from calculation
have "â¨?f ` n, ?f ` succ(n)â© â R" if "nânat" for n
using witness_related[OF â¹aâA⺠_ 0, of g n] 1 that
by (auto dest:transM)
ultimately
have "âf[M]. fânat â A ⧠f ` 0 = a ⧠(ânânat. â¨f ` n, f ` succ(n)â© â R)"
using 0 1 â¹aâ_âº
by (rule_tac x="(λnâÏ. dc_witness(n, A, a, g, R))" in rexI)
(simp_all, rule_tac witness_funtype,
auto intro!: Lambda_dc_witness_closed dest:transM)
}
with â¹M(A)âº
show ?thesis using function_space_rel_char by auto
qed
lemma aux_DC_on_AxNat2 : "âxâAÃnat. âyâA. â¨x,â¨y,succ(snd(x))â©â© â R â¹
âxâAÃnat. âyâAÃnat. â¨x,yâ© â {â¨a,bâ©âR. snd(b) = succ(snd(a))}"
by (rule ballI, erule_tac x="x" in ballE, simp_all)
lemma infer_snd : "câ AÃB â¹ snd(c) = k â¹ c=â¨fst(c),kâ©"
by auto
corollary DC_on_A_x_nat :
assumes "(âxâAÃnat. âyâA. â¨x,â¨y,succ(snd(x))â©â© â R)" "aâA" "M(A)" "M(R)"
shows "âf â natââMâA. f`0 = a ⧠(ân â nat. â¨â¨f`n,nâ©,â¨f`succ(n),succ(n)â©â©âR)" (is "âxâ_.?P(x)")
proof -
let ?R'="{â¨a,bâ©âR. snd(b) = succ(snd(a))}"
from assms(1)
have "âxâAÃnat. âyâAÃnat. â¨x,yâ© â ?R'"
using aux_DC_on_AxNat2 by simp
moreover
note â¹aâ_⺠â¹M(A)âº
moreover from this
have "M(A Ã Ï)" by simp
have "lam_replacement(M, λx. succ(snd(fst(x))))"
using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
lam_replacement_hcomp[of _ "λx. succ(snd(x))"]
lam_replacement_succ by simp
with â¹M(R)âº
have "M(?R')"
using separation_eq lam_replacement_fst lam_replacement_snd
lam_replacement_succ lam_replacement_hcomp lam_replacement_identity
unfolding split_def by simp
ultimately
obtain f where
F:"fânatââMâ AÃÏ" "f ` 0 = â¨a,0â©" "ânânat. â¨f ` n, f ` succ(n)â© â ?R'"
using pointed_DC[of "AÃnat" ?R'] by blast
with â¹M(A)âº
have "M(f)" using function_space_rel_char by simp
then
have "M(λxânat. fst(f`x))" (is "M(?f)")
using lam_replacement_fst lam_replacement_hcomp
lam_replacement_constant lam_replacement_identity
lam_replacement_apply
by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
auto
with F â¹M(A)âº
have "?fânatââMâ A" "?f ` 0 = a" using function_space_rel_char by auto
have 1:"nâ nat â¹ f`n= â¨?f`n, nâ©" for n
proof(induct n set:nat)
case 0
then show ?case using F by simp
next
case (succ x)
with â¹M(A)âº
have "â¨f`x, f`succ(x)â© â ?R'" "f`x â AÃnat" "f`succ(x)âAÃnat"
using F function_space_rel_char[of Ï "AÃÏ"] by auto
then
have "snd(f`succ(x)) = succ(snd(f`x))" by simp
with succ â¹f`xâ_âº
show ?case using infer_snd[OF â¹f`succ(_)â_âº] by auto
qed
have "â¨â¨?f`n,nâ©,â¨?f`succ(n),succ(n)â©â© â R" if "nânat" for n
using that 1[of "succ(n)"] 1[OF â¹nâ_âº] F(3) by simp
with â¹f`0=â¨a,0â©âº
show ?thesis
using rev_bexI[OF â¹?fâ_âº] by simp
qed
lemma aux_sequence_DC :
assumes "âxâA. ânânat. âyâA. â¨x,yâ© â S`n"
"R={â¨â¨x,nâ©,â¨y,mâ©â© â (AÃnat)Ã(AÃnat). â¨x,yâ©âS`m }"
shows "â xâAÃnat . âyâA. â¨x,â¨y,succ(snd(x))â©â© â R"
using assms Pair_fst_snd_eq by auto
lemma aux_sequence_DC2 : "âxâA. ânânat. âyâA. â¨x,yâ© â S`n â¹
âxâAÃnat. âyâA. â¨x,â¨y,succ(snd(x))â©â© â {â¨â¨x,nâ©,â¨y,mâ©â©â(AÃnat)Ã(AÃnat). â¨x,yâ©âS`m }"
by auto
lemma sequence_DC:
assumes "âxâA. ânânat. âyâA. â¨x,yâ© â S`n" "M(A)" "M(S)"
shows "âaâA. (âf â natââMâ A. f`0 = a ⧠(ân â nat. â¨f`n,f`succ(n)â©âS`succ(n)))"
proof -
from â¹M(S)âº
have "lam_replacement(M, λx. S ` snd(snd(x)))"
using lam_replacement_snd lam_replacement_hcomp
lam_replacement_hcomp[of _ "λx. S`snd(x)"] lam_replacement_apply by simp
with assms
have "M({x â (A à Ï) à A Ã Ï . (λâ¨â¨x,nâ©,y,mâ©. â¨x, yâ© â S ` m)(x)})"
using lam_replacement_fst lam_replacement_snd
lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
of "λx. fst(fst(x))" "λx. fst(snd(x))", THEN [2] separation_in,
of "λx. S ` snd(snd(x))"] lam_replacement_apply[of S]
lam_replacement_hcomp unfolding split_def by simp
with assms
show ?thesis
by (rule_tac ballI) (drule aux_sequence_DC2, drule DC_on_A_x_nat, auto)
qed
end
end
Theory Partial_Functions_Relative
sectionâ¹Cohen forcing notionsâº
theory Partial_Functions_Relative
imports
Cardinal_Library_Relative
begin
textâ¹In this theory we introduce bounded partial functions and its relative
version; for historical reasons the relative version is based on a proper
definition of partial functions.
We note that finite partial functions are easier and are used to prove
some lemmas about finite sets in the theory
\<^theory>â¹Transitive_Models.ZF_Library_Relativeâº.âº
definition
Fn :: "[i,i,i] â i" where
"Fn(κ,I,J) â¡ â{y . d â Pow(I), y=(dâJ) ⧠dâºÎº}"
lemma domain_function_lepoll :
assumes "function(r)"
shows "domain(r) â² r"
proof -
let ?f="λxâdomain(r) . <x,THE y . <x,y> â r>"
have 1:"âx. x â domain(r) â¹ â!y. <x,y> â r"
using assms unfolding domain_def function_def by auto
then
have "?f â inj(domain(r), r)"
using theI[OF 1]
by(rule_tac lam_injective,auto)
then
show ?thesis unfolding lepoll_def
by force
qed
lemma function_lepoll:
assumes "r:dâJ"
shows "r â² d"
proof -
let ?f="λxâr . fst(x)"
note assms Pi_iff[THEN iffD1,OF assms]
moreover from this
have 1:"âx. x â domain(r) â¹ â!y. <x,y> â r"
unfolding function_def by auto
moreover from calculation
have "(THE u . <fst(x),u> â r) = snd(x)" if "xâr" for x
using that subsetD[of r "dÃJ" x] theI[OF 1]
by(auto,rule_tac the_equality2[OF 1],auto)
moreover from calculation
have "âx. x âr â¹ <fst(x),THE y . <fst(x),y> â r> = x"
by auto
ultimately
have "?fâinj(r,d)"
by(rule_tac d= "λu . <u,THE y . <u,y> â r>" in lam_injective,force,simp)
then
show ?thesis
unfolding lepoll_def
by auto
qed
lemma function_eqpoll :
assumes "r:dâJ"
shows "r â d"
using assms domain_of_fun domain_function_lepoll Pi_iff[THEN iffD1,OF assms]
eqpollI[OF function_lepoll[OF assms]] subset_imp_lepoll
by force
lemma Fn_char : "Fn(κ,I,J) = {f â Pow(IÃJ) . function(f) ⧠f ⺠κ}" (is "?L=?R")
proof (intro equalityI subsetI)
fix x
assume "x â ?R"
moreover from this
have "domain(x) â Pow(I)" "domain(x) â² x" "x⺠κ"
using domain_function_lepoll
by auto
ultimately
show "x â ?L"
unfolding Fn_def
using lesspoll_trans1 Pi_iff
by (auto,rule_tac rev_bexI[of "domain(x) â J"],auto)
next
fix x
assume "x â ?L"
then
obtain d where "x:dâJ" "d â Pow(I)" "dâºÎº"
unfolding Fn_def
by auto
moreover from this
have "xâºÎº"
using function_lepoll[THEN lesspoll_trans1] by auto
moreover from calculation
have "x â Pow(IÃJ)" "function(x)"
using Pi_iff by auto
ultimately
show "x â ?R" by simp
qed
lemma zero_in_Fn:
assumes "0 < κ"
shows "0 â Fn(κ, I, J)"
using lt_Card_imp_lesspoll assms zero_lesspoll
unfolding Fn_def
by (simp,rule_tac x="0âJ" in bexI,simp)
(rule ReplaceI[of _ 0],simp_all)
lemma Fn_nat_eq_FiniteFun: "Fn(nat,I,J) = I -||> J"
proof (intro equalityI subsetI)
fix x
assume "x â I -||> J"
then
show "x â Fn(nat,I,J)"
proof (induct)
case emptyI
then
show ?case
using zero_in_Fn ltI
by simp
next
case (consI a b h)
then
obtain d where "h:dâJ" "dâºnat" "dâI"
unfolding Fn_def by auto
moreover from this
have "Finite(d)"
using lesspoll_nat_is_Finite by simp
ultimately
have "h : d -||> J"
using fun_FiniteFunI Finite_into_Fin by blast
note â¹h:dâJâº
moreover from this
have "domain(cons(â¨a, bâ©, h)) = cons(a,d)" (is "domain(?h) = ?d")
and "domain(h) = d"
using domain_of_fun by simp_all
moreover
note consI
moreover from calculation
have "cons(â¨a, bâ©, h) â cons(a,d) â J"
using fun_extend3 by simp
moreover from â¹Finite(d)âº
have "Finite(cons(a,d))" by simp
moreover from this
have "cons(a,d) ⺠nat" using Finite_imp_lesspoll_nat by simp
ultimately
show ?case
unfolding Fn_def
by (simp,rule_tac x="?dâJ" in bexI)
(force dest:app_fun)+
qed
next
fix x
assume "x â Fn(nat,I,J)"
then
obtain d where "x:dâJ" "d â Pow(I)" "dâºnat"
unfolding Fn_def
by auto
moreover from this
have "Finite(d)"
using lesspoll_nat_is_Finite by simp
moreover from calculation
have "d â Fin(I)"
using Finite_into_Fin[of d] Fin_mono by auto
ultimately
show "x â I -||> J" using fun_FiniteFunI FiniteFun_mono by blast
qed
lemma Fn_nat_subset_Pow: "Fn(κ,I,J) â Pow(IÃJ)"
using Fn_char by auto
lemma FnI:
assumes "p : d â J" "d â I" "d ⺠κ"
shows "p â Fn(κ,I,J)"
using assms
unfolding Fn_def by auto
lemma FnD[dest]:
assumes "p â Fn(κ,I,J)"
shows "âd. p : d â J ⧠d â I ⧠d ⺠κ"
using assms
unfolding Fn_def by auto
lemma Fn_is_function: "p â Fn(κ,I,J) â¹ function(p)"
unfolding Fn_def using fun_is_function by auto
lemma Fn_csucc:
assumes "Ord(κ)"
shows "Fn(csucc(κ),I,J) = â{y . d â Pow(I), y=(dâJ) ⧠dâ²Îº}"
using assms
unfolding Fn_def using lesspoll_csucc by (simp)
definition
FnleR :: "i â i â o" (infixl â¹â⺠50) where
"f â g â¡ g â f"
lemma FnleR_iff_subset [iff]: "f â g â· g â f"
unfolding FnleR_def ..
definition
Fnlerel :: "i â i" where
"Fnlerel(A) â¡ Rrel(λx y. x â y,A)"
definition
Fnle :: "[i,i,i] â i" where
"Fnle(κ,I,J) ⡠Fnlerel(Fn(κ,I,J))"
lemma FnleI[intro]:
assumes "p â Fn(κ,I,J)" "q â Fn(κ,I,J)" "p â q"
shows "â¨p,qâ© â Fnle(κ,I,J)"
using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
by auto
lemma FnleD[dest]:
assumes "â¨p,qâ© â Fnle(κ,I,J)"
shows "p â Fn(κ,I,J)" "q â Fn(κ,I,J)" "p â q"
using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
by auto
definition PFun_Space_Rel :: "[i,iâo, i] â i" ("_ââ_â_")
where "A ââMâ B â¡ {f â Pow(AÃB) . M(f) ⧠function(f)}"
lemma (in M_library) PFun_Space_subset_Powrel :
assumes "M(A)" "M(B)"
shows "A ââMâ B = {f â PowâMâ(AÃB) . function(f)}"
using Pow_rel_char assms
unfolding PFun_Space_Rel_def
by auto
lemma (in M_library) PFun_Space_closed :
assumes "M(A)" "M(B)"
shows "M(A ââMâ B)"
using assms PFun_Space_subset_Powrel separation_is_function
by auto
lemma Un_filter_fun_space_closed:
assumes "G â I â J" "â f g . fâG â¹ gâG â¹ âdâIâ J . d â f ⧠d â g"
shows "âG â Pow(IÃJ)" "function(âG)"
proof -
from assms
show "âG â Pow(IÃJ)"
using Union_Pow_iff
unfolding Pi_def
by auto
next
show "function(âG)"
unfolding function_def
proof(auto)
fix B B' x y y'
assume "B â G" "â¨x, yâ© â B" "B' â G" "â¨x, y'â© â B'"
moreover from assms this
have "B â I â J" "B' â I â J"
by auto
moreover from calculation assms(2)[of B B']
obtain d where "d â B" "d â B'" "dâI â J" "â¨x, yâ© â d" "â¨x, y'â© â d"
using subsetD[OF â¹Gâ_âº]
by auto
then
show "y=y'"
using fun_is_function[OF â¹dâ_âº]
unfolding function_def
by force
qed
qed
lemma Un_filter_is_fun :
assumes "G â I â J" "â f g . fâG â¹ gâG â¹ âdâIâ J . dâf ⧠dâg" "Gâ 0"
shows "âG â I â J"
using assms Un_filter_fun_space_closed Pi_iff
proof(simp_all)
show "Iâdomain(âG)"
proof -
from â¹Gâ 0âº
obtain f where "fââG" "fâG"
by auto
with â¹Gâ_âº
have "fâIâJ" by auto
then
show ?thesis
using subset_trans[OF _ domain_mono[OF â¹fââGâº],of I]
unfolding Pi_def by auto
qed
qed
context M_cardinals
begin
lemma mem_function_space_relD:
assumes "f â function_space_rel(M,A,y)" "M(A)" "M(y)"
shows "f â A â y" and "M(f)"
using assms function_space_rel_char by simp_all
lemma pfunI :
assumes "CâA" "f â C ââMâ B" "M(C)" "M(B)"
shows "fâ A ââMâ B"
proof -
from assms
have "f â CâB" "M(f)"
using mem_function_space_relD
by simp_all
with assms
show ?thesis
using Pi_iff
unfolding PFun_Space_Rel_def
by auto
qed
lemma zero_in_PFun_rel:
assumes "M(I)" "M(J)"
shows "0 â I ââMâ J"
using pfunI[of 0] nonempty mem_function_space_rel_abs assms
by simp
lemma pfun_subsetI :
assumes "f â A ââMâ B" "gâf" "M(g)"
shows "gâ A ââMâ B"
using assms function_subset
unfolding PFun_Space_Rel_def
by auto
lemma pfun_is_function :
"f â AââMâ B â¹ function(f)"
unfolding PFun_Space_Rel_def by simp
lemma pfun_Un_filter_closed:
assumes "G âIââMâ J" "â f g . fâG â¹ gâG â¹ âdâIââMâ J . dâf ⧠dâg"
shows "âG â Pow(IÃJ)" "function(âG)"
proof -
from assms
show "âG â Pow(IÃJ)"
using Union_Pow_iff
unfolding PFun_Space_Rel_def
by auto
next
show "function(âG)"
unfolding function_def
proof(auto)
fix B B' x y y'
assume "B â G" "â¨x, yâ© â B" "B' â G" "â¨x, y'â© â B'"
moreover from calculation assms
obtain d where "d â I ââMâ J" "function(d)" "â¨x, yâ© â d" "â¨x, y'â© â d"
using pfun_is_function
by force
ultimately
show "y=y'"
unfolding function_def
by auto
qed
qed
lemma pfun_Un_filter_closed'':
assumes "G âIââMâ J" "â f g . fâG â¹ gâG â¹ âdâG . dâf ⧠dâg"
shows "âG â Pow(IÃJ)" "function(âG)"
proof -
from assms
have "â f g . fâG â¹ gâG â¹ âdâIââMâ J . dâf ⧠dâg"
using subsetD[OF assms(1),THEN [2] bexI]
by force
then
show "âG â Pow(IÃJ)" "function(âG)"
using assms pfun_Un_filter_closed
unfolding PFun_Space_Rel_def
by auto
qed
lemma pfun_Un_filter_closed':
assumes "G âIââMâ J" "â f g . fâG â¹ gâG â¹ âdâG . dâf ⧠dâg" "M(G)"
shows "âG â IââMâ J"
using assms pfun_Un_filter_closed''
unfolding PFun_Space_Rel_def
by auto
lemma pfunD :
assumes "f â AââMâ B"
shows "âC[M]. CâA ⧠f â CâB"
proof -
note assms
moreover from this
have "fâPow(AÃB)" "function(f)" "M(f)"
unfolding PFun_Space_Rel_def
by simp_all
moreover from this
have "domain(f) â A" "f â domain(f) â B" "M(domain(f))"
using assms Pow_iff[of f "AÃB"] domain_subset Pi_iff
by auto
ultimately
show ?thesis by auto
qed
lemma pfunD_closed :
assumes "f â AââMâ B"
shows "M(f)"
using assms
unfolding PFun_Space_Rel_def by simp
lemma pfun_singletonI :
assumes "x â A" "b â B" "M(A)" "M(B)"
shows "{â¨x,bâ©} â AââMâ B"
using assms transM[of x A] transM[of b B]
unfolding PFun_Space_Rel_def function_def
by auto
lemma pfun_unionI :
assumes "f â AââMâ B" "g â AââMâ B" "domain(f)â©domain(g)=0"
shows "fâªg â AââMâ B"
using assms
unfolding PFun_Space_Rel_def function_def
by blast
lemma (in M_library) pfun_restrict_eq_imp_compat:
assumes "f â IââMâ J" "g â IââMâ J" "M(J)"
"restrict(f, domain(f) â© domain(g)) = restrict(g, domain(f) â© domain(g))"
shows "f ⪠g â IââMâ J"
proof -
note assms
moreover from this
obtain C D where "f : C â J" "C â I" "D â I" "M(C)" "M(D)" "g : D â J"
using pfunD[of f] pfunD[of g] by force
moreover from calculation
have "fâªg â CâªD â J"
using restrict_eq_imp_Un_into_Pi'[OF â¹fâCâ_⺠â¹gâDâ_âº]
by auto
ultimately
show ?thesis
using pfunI[of "CâªD" _ "fâªg"] Un_subset_iff pfunD_closed function_space_rel_char
by auto
qed
lemma FiniteFun_pfunI :
assumes "f â A-||> B" "M(A)" "M(B)"
shows "f â A ââMâ B"
using assms(1)
proof(induct)
case emptyI
then
show ?case
using assms nonempty mem_function_space_rel_abs pfunI[OF empty_subsetI, of 0]
by simp
next
case (consI a b h)
note consI
moreover from this
have "M(a)" "M(b)" "M(h)" "domain(h) â A"
using transM[OF _ â¹M(A)âº] transM[OF _ â¹M(B)âº]
FinD
FiniteFun_domain_Fin
pfunD_closed
by simp_all
moreover from calculation
have "{a}âªdomain(h)âA" "M({a}âªdomain(h))" "M(cons(<a,b>,h))" "domain(cons(<a,b>,h)) = {a}âªdomain(h)"
by auto
moreover from calculation
have "cons(<a,b>,h) â {a}âªdomain(h) â B"
using FiniteFun_is_fun[OF FiniteFun.consI, of a A b B h]
by auto
ultimately
show "cons(<a,b>,h) â A ââMâ B"
using assms mem_function_space_rel_abs pfunI
by simp_all
qed
lemma PFun_FiniteFunI :
assumes "f â A ââMâ B" "Finite(f)"
shows "f â A-||> B"
proof -
from assms
have "fâFin(AÃB)" "function(f)"
using Finite_Fin Pow_iff
unfolding PFun_Space_Rel_def
by auto
then
show ?thesis
using FiniteFunI by simp
qed
end
definition
Fn_rel :: "[iâo,i,i,i] â i" (â¹Fnâ_â'(_,_,_')âº) where
"Fn_rel(M,κ,I,J) â¡ {f â IââMâ J . f âºâMâ κ}"
context M_library
begin
lemma Fn_rel_subset_PFun_rel : "FnâMâ(κ,I,J) â IââMâ J"
unfolding Fn_rel_def by auto
lemma Fn_relI[intro]:
assumes "f : d â J" "d â I" "f âºâMâ κ" "M(d)" "M(J)" "M(f)"
shows "f â Fn_rel(M,κ,I,J)"
using assms pfunI mem_function_space_rel_abs
unfolding Fn_rel_def
by auto
lemma Fn_relD[dest]:
assumes "p â Fn_rel(M,κ,I,J)"
shows "âC[M]. CâI ⧠p : C â J ⧠p âºâMâ κ"
using assms pfunD
unfolding Fn_rel_def
by simp
lemma Fn_rel_is_function:
assumes "p â Fn_rel(M,κ,I,J)"
shows "function(p)" "M(p)" "p âºâMâ κ" "pâ IââMâ J"
using assms
unfolding Fn_rel_def PFun_Space_Rel_def by simp_all
lemma Fn_rel_mono:
assumes "p â Fn_rel(M,κ,I,J)" "κ âºâMâ κ'" "M(κ)" "M(κ')"
shows "p â Fn_rel(M,κ',I,J)"
using assms lesspoll_rel_trans[OF _ assms(2)] cardinal_rel_closed
Fn_rel_is_function(2)[OF assms(1)]
unfolding Fn_rel_def
by simp
lemma Fn_rel_mono':
assumes "p â Fn_rel(M,κ,I,J)" "κ â²âMâ κ'" "M(κ)" "M(κ')"
shows "p â Fn_rel(M,κ',I,J)"
proof -
note assms
then
consider "κ âºâMâ κ'" | "κ ââMâ κ'"
using lepoll_rel_iff_leqpoll_rel
by auto
then
show ?thesis
proof(cases)
case 1
with assms show ?thesis using Fn_rel_mono by simp
next
case 2
then show ?thesis
using assms cardinal_rel_closed Fn_rel_is_function[OF assms(1)]
lesspoll_rel_eq_trans
unfolding Fn_rel_def
by simp
qed
qed
lemma Fn_csucc:
assumes "Ord(κ)" "M(κ)"
shows "Fn_rel(M,(κâ§+)âMâ,I,J) = {pâ IââMâ J . p â²âMâ κ}" (is "?L=?R")
using assms
proof(intro equalityI)
show "?L â ?R"
proof(intro subsetI)
fix p
assume "pâ?L"
then
have "p âºâMâ csucc_rel(M,κ)" "M(p)" "pâ IââMâ J"
using Fn_rel_is_function by simp_all
then
show "pâ?R"
using assms lesspoll_rel_csucc_rel by simp
qed
next
show "?Râ?L"
proof(intro subsetI)
fix p
assume "pâ?R"
then
have "pâ IââMâ J" "p â²âMâ κ"
using assms lesspoll_rel_csucc_rel by simp_all
then
show "pâ?L"
using assms lesspoll_rel_csucc_rel pfunD_closed
unfolding Fn_rel_def
by simp
qed
qed
lemma Finite_imp_lesspoll_nat:
assumes "Finite(A)"
shows "A ⺠nat"
using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
n_lesspoll_nat eq_lesspoll_trans
unfolding Finite_def lesspoll_def by auto
lemma FinD_Finite :
assumes "aâFin(A)"
shows "Finite(a)"
using assms
by(induct,simp_all)
lemma Fn_rel_nat_eq_FiniteFun:
assumes "M(I)" "M(J)"
shows "I -||> J = Fn_rel(M,Ï,I,J)"
proof(intro equalityI subsetI)
fix p
assume "pâI -||> J"
with assms
have "pâ I ââMâ J" "Finite(p)"
using FiniteFun_pfunI FinD_Finite[OF subsetD[OF FiniteFun.dom_subset,OF â¹pâ_âº]]
by auto
moreover from this
have "p âºâMâ Ï"
using Finite_lesspoll_rel_nat pfunD_closed[of p] n_lesspoll_rel_nat
by simp
ultimately
show "pâ Fn_rel(M,Ï,I,J)"
unfolding Fn_rel_def by simp
next
fix p
assume "pâ Fn_rel(M,Ï,I,J)"
then
have "pâ I ââMâ J" "p âºâMâ Ï"
unfolding Fn_rel_def by simp_all
moreover from this
have "Finite(p)"
using Finite_cardinal_rel_Finite lesspoll_rel_nat_is_Finite_rel pfunD_closed
cardinal_rel_closed[of p] Finite_cardinal_rel_iff'[THEN iffD1]
by simp
ultimately
show "pâI -||> J"
using PFun_FiniteFunI
by simp
qed
lemma Fn_nat_abs:
assumes "M(I)" "M(J)"
shows "Fn(nat,I,J) = Fn_rel(M,Ï,I,J)"
using assms Fn_rel_nat_eq_FiniteFun Fn_nat_eq_FiniteFun
by simp
lemma Fn_rel_singletonI:
assumes "x â I" "j â J" "1 âºâMâ κ" "M(κ)" "M(I)" "M(J)"
shows "{â¨x,jâ©} â FnâMâ(κ,I,J)"
using pfun_singletonI transM[of x] transM[of j] assms
eq_lesspoll_rel_trans[OF singleton_eqpoll_rel_1]
unfolding Fn_rel_def
by auto
end
definition
Fnle_rel :: "[iâo,i,i,i] â i" (â¹Fnleâ_â'(_,_,_')âº) where
"Fnle_rel(M,κ,I,J) â¡ Fnlerel(FnâMâ(κ,I,J))"
abbreviation
Fn_r_set :: "[i,i,i,i] â i" (â¹Fnâ_â'(_,_,_')âº) where
"Fn_r_set(M) â¡ Fn_rel(##M)"
abbreviation
Fnle_r_set :: "[i,i,i,i] â i" (â¹Fnleâ_â'(_,_,_')âº) where
"Fnle_r_set(M) â¡ Fnle_rel(##M)"
context M_library
begin
lemma Fnle_relI[intro]:
assumes "p â Fn_rel(M,κ,I,J)" "q â Fn_rel(M,κ,I,J)" "p â q"
shows "<p,q> â Fnle_rel(M,κ,I,J)"
using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
by auto
lemma Fnle_relD[dest]:
assumes "<p,q> â Fnle_rel(M,κ,I,J)"
shows "p â Fn_rel(M,κ,I,J)" "q â Fn_rel(M,κ,I,J)" "p â q"
using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
by auto
lemma Fn_rel_closed[intro,simp]:
assumes "M(κ)" "M(I)" "M(J)"
shows "M(FnâMâ(κ,I,J))"
using assms separation_cardinal_rel_lesspoll_rel PFun_Space_closed
unfolding Fn_rel_def
by auto
lemma Fn_rel_subset_Pow:
assumes "M(κ)" "M(I)" "M(J)"
shows "FnâMâ(κ,I,J) â Pow(IÃJ)"
unfolding Fn_rel_def PFun_Space_Rel_def
by auto
lemma Fnle_rel_closed[intro,simp]:
assumes "M(κ)" "M(I)" "M(J)"
shows "M(FnleâMâ(κ,I,J))"
unfolding Fnle_rel_def Fnlerel_def Rrel_def FnleR_def
using assms supset_separation Fn_rel_closed
by auto
lemma zero_in_Fn_rel:
assumes "0<κ" "M(κ)" "M(I)" "M(J)"
shows "0 â FnâMâ(κ, I, J)"
unfolding Fn_rel_def
using zero_in_PFun_rel zero_lesspoll_rel assms
by simp
lemma zero_top_Fn_rel:
assumes "pâFnâMâ(κ, I, J)" "0<κ" "M(κ)" "M(I)" "M(J)"
shows "â¨p, 0â© â FnleâMâ(κ, I, J)"
using assms zero_in_Fn_rel unfolding preorder_on_def refl_def trans_on_def
by auto
lemma preorder_on_Fnle_rel:
assumes "M(κ)" "M(I)" "M(J)"
shows "preorder_on(FnâMâ(κ, I, J), FnleâMâ(κ, I, J))"
unfolding preorder_on_def refl_def trans_on_def
by blast
end
end